home *** CD-ROM | disk | FTP | other *** search
/ The 640 MEG Shareware Studio 2 / The 640 Meg Shareware Studio CD-ROM Volume II (Data Express)(1993).ISO / pascal / reform.zip / REFORM.PAS < prev   
Pascal/Delphi Source File  |  1989-12-24  |  74KB  |  3,003 lines
  1. (*[I=2,P=2,O=78,R+,V+] REFORM Formatter directives*)
  2.  
  3. PROGRAM REFORM(INPUT, OUTPUT, SOURCE, RESULT);
  4.  
  5. USES
  6.   DOS;
  7.  
  8. (*
  9.  *
  10.  * REFORM - A Turbo Pascal Program Formatter (Pretty Printer).
  11.  *
  12.  * Copyright (C) 1981/1982/1984/1986/1987/1988/1989 - R.A. Highness
  13.  *
  14.  * Last Updated: 12/24/89 03:20am
  15.  *
  16.  * While this program is copyrighted, you can make any changes that you
  17.  * feel are necessary.  This program CANNOT be incorporated into any
  18.  * commercial application without the written consent of the author.
  19.  * My only request is that if you do make any changes to this source code,
  20.  * you MUST make the source available to everyone.
  21.  *
  22.  * If you have questions/comments/bitches/etcettera, you can contact me at:
  23.  *
  24.  * CompuServe       U.S. Mail               FidoNET
  25.  * ----------       ------------------      -----------------------
  26.  * 76004,3122       3203 Clayton Road       Solano College PCUG BBS
  27.  *                  Apartment 14            (707)-437-OPUS  (6787)
  28.  *                  Concord, CA  94519      1200/2400 8-N-1
  29.  *                                          1:161/8
  30.  *
  31.  * REFORM will format a Pascal program (or fragment) according to standardized
  32.  * formatting rules.REFORM will also convert the case of the identifiers and
  33.  * reserved words to either upper/lower case depending on imbedded formatting
  34.  * directives.
  35.  *
  36.  * The series of formatting directives allow (almost) complete control over
  37.  * program formatting.
  38.  *
  39.  * REFORM does does a complete syntactical check (almost) of the entire
  40.  * program as it formats.If REFORM encounters syntactical problems, it will
  41.  * abort and will not create an output file. By doing this, REFORM eliminates
  42.  * a problem which other formatting programs had of losing track of where
  43.  * they were and creating complete nonsense as an output file.The extra
  44.  * overhead used by doing a syntactical check of the program takes a
  45.  * little longer, but I feel that the extra time involved is well worth it.
  46.  *
  47.  * Comments in Pascal (as with any language) are always difficult (at best)
  48.  * to deal with, and REFORM attempts to deal with them in such a way that the
  49.  * user has some control over what happens with the comments.
  50.  * The comment handling procedures/functions of REFORM are completely separate
  51.  * from the normal formatting, and can be re-written (or deleted) without
  52.  * affecting the formatting ability of other areas.
  53.  *
  54.  *
  55.  * Version History:
  56.  * ----------------
  57.  *
  58.  * 03/14/81 - Version 0.001
  59.  * Initial version.  Runs on CDC Cyber 70 series mainframe.
  60.  *
  61.  * 04/11/81 - Version 0.010
  62.  * Fixed cosmetic changes (typos).
  63.  *
  64.  * 01/28/82 - Version 0.301
  65.  * Formatting modifications, no bug fixes (yet).
  66.  *
  67.  * 09/13/83 - Version 0.538
  68.  * Rewrote a *MAJOR* portion of the formatting code.  Added control card
  69.  * support.  Used by EPA/WAKIM.
  70.  *
  71.  * 09/30/84 - Version 0.843
  72.  * Ported to the Apple ][ under Turbo Pascal.  Barely runs (mostly due to
  73.  * speed of the Apple ][).  Ocassionally crashes.  The WHILE and WITH
  74.  * statements now do not force a blank line before and after.  The block
  75.  * header does not output extra blank lines.   *NOTE: The programmer MUST
  76.  * insert a blank line before the BEGIN statement if one is so desired.
  77.  *
  78.  * The lexical scanner was re-written to handle Turbo Pascal's hex
  79.  * constants, and the Turbo Pascal FILE type was added.
  80.  *
  81.  * 05/11/85 - Version 1.453
  82.  * REFORM now allows nested comments.
  83.  *
  84.  * 05/20/86 - Version 1.973
  85.  * Re-wrote the code for formatting statement comments. Comments in CONST,
  86.  * TYPE, and VAR declarations are now aligned to the remark column (initial
  87.  * value is 40).All other statement comments are formatted as they were
  88.  * before.
  89.  *
  90.  * 12/21/86 - Version 1.994
  91.  * REFORM now handles OVERLAY and INLINE statements correctly.Minor bug
  92.  * fixes.
  93.  *
  94.  * 08/28/87 - Version 2.003
  95.  * REFORM now handles the USES statement in Turbo Pascal 4.0/5.0.
  96.  *
  97.  * 11/21/88 - Version 2.013
  98.  * REFORM now will insert a blank line if the BEGIN statement is either the
  99.  * first statement after a PROCEDURE/FUNCTION statement, or after the VAR
  100.  * statement.
  101.  *
  102.  * 11/23/88 - Version 2.101
  103.  * REFORM now concatenates CASE statements on the same line as the condition
  104.  * (if it fits).  Minor bugs fixed to make the END statement line up with the
  105.  * CASE statements.
  106.  *
  107.  * 11/27/88 - Version 2.352
  108.  * New formatting directive added.  K+/- Will "kill" all comments found in
  109.  * the input file.  It will *NOT* delete compiler directives or formatting
  110.  * commands.  More than ever, it is IMPARATIVE that all formatting directives
  111.  * be put on their own line!
  112.  *
  113.  * 11/28/88 - Version 2.401
  114.  * Added on-line help.  To see what formatting directives are available
  115.  * type REFORM /? and the help will be shown.
  116.  *
  117.  * 02/07/89 - Version 2.433
  118.  * Minor glitch fixes.  No *MAJOR* changes.  Mostly cosmetic changes.
  119.  *
  120.  * 12/24/89 - Version 2.501
  121.  * Cosmetic changes.  Source commented and cleaned up for initial release.
  122.  *
  123.  *)
  124.  
  125. CONST
  126.   REFORMVERSION = 'REFORM - Version 2.501 - (C) 1981-1989 R.A. Highness';
  127.   MAXLINELEN = 250;
  128.   BUFSIZE = 152;
  129.   BUFSIZEP1 = 153;
  130.   BUFSIZEM1 = 151;
  131.   MAXWORDLEN = 9;
  132.   NORESWORDS = 45;
  133.   DEFAULTOUTLINE = 78;
  134.   DEFAULTTABSPACES = 3;
  135.   DEFAULTCOMMENTSPACES = 1;
  136.   MAXBREAKLEVEL = 4;
  137.   FF = 12;
  138.   HT = 9;
  139.   STRINGBLOCKSIZE = 512;
  140.   STRINGBLOCKMAX = 511;
  141.   STRINGINDEXMAX = 63;
  142.   TABINTERVAL = 6;
  143.  
  144. TYPE
  145.   SYMBOLS = (ABSOLUTESYM, ANDSYM, ARRAYSYM, BEGINSYM, CASESYM, CONSTSYM,
  146.              DIVSYM, DOSYM, DOWNTOSYM, ELSESYM, ENDSYM, EXTERNSYM, FILESYM,
  147.              FORSYM, FORWARDSYM, FUNCTIONSYM, GOTOSYM, IFSYM, INSYM,
  148.              INLINESYM, LABELSYM, MODSYM, NILSYM, NOTSYM, OFSYM, ORSYM,
  149.              OVERLAYSYM, PACKEDSYM, PROCEDURESYM, PROGRAMSYM, RECORDSYM,
  150.              REPEATSYM, SETSYM, SHLSYM, SHRSYM, STRINGSYM, THENSYM, TOSYM,
  151.              TYPESYM, UNTILSYM, USESSYM, VARSYM, WHILESYM, WITHSYM, XORSYM,
  152.              PLUS, MINUS, MULT, DIVIDE, BECOMES, PERIOD, COMMA, SEMICOLON,
  153.              COLON, EQUAL, RELOP, POINTER, SUBRANGE, APOSTROPHY, OPENPAREN,
  154.              CLOSEPAREN, OPENBRACK, CLOSEBRACK, IDENTIFIER, NUMBER, STRCONST,
  155.              COMMENT, TEXTEND);
  156.   SETOFSYMS = SET OF SYMBOLS;
  157.   STRINGTYPE = PACKED ARRAY [1..12] OF CHAR;
  158.   WORDTYPE = PACKED ARRAY [1..MAXWORDLEN] OF CHAR;
  159.   LENTABLETYPE =
  160.     RECORD
  161.       LOWINDEX, HIINDEX: 1..NORESWORDS;
  162.     END;
  163.   LINEINDEX = 0..MAXLINELEN;
  164.   ACTIONS = (GRAPHIC, SPACES, BEGINLINE);
  165.   BUFFERINDEX = 0..BUFSIZEM1;
  166.   CHARBUFFER = ARRAY [BUFFERINDEX] OF
  167.       RECORD
  168.         CASE ACTIONIS: ACTIONS OF
  169.           SPACES, BEGINLINE:
  170.             (SPACING: LINEINDEX);
  171.           GRAPHIC:
  172.             (CHARACTER: CHAR)
  173.       END;
  174.   COLLOG =
  175.     RECORD
  176.       LOGCHAR: INTEGER;
  177.       LOGCOL: LINEINDEX;
  178.       LOGLINE: INTEGER;
  179.     END;
  180.   BREAKLEV = 0..MAXBREAKLEVEL;
  181.   ABORTKIND = (SYNTAX, NESTING, COMFORMAT);
  182.   STRINGBLOCKINDEX = 0..STRINGINDEXMAX;
  183.   STRINGPIECEINDEX = 0..STRINGBLOCKMAX;
  184.   STRINGBLOCK = PACKED ARRAY [STRINGPIECEINDEX] OF CHAR;
  185.  
  186. VAR
  187.   RESVWRD: ARRAY [1..NORESWORDS] OF WORDTYPE;
  188.   RESSYMBOL: ARRAY [1..NORESWORDS] OF SYMBOLS;
  189.   RESLEN: ARRAY [2..MAXWORDLEN] OF LENTABLETYPE;
  190.   UPPERCASE, LOWERCASE: ARRAY [CHAR] OF CHAR;
  191.   CH, PREVCH: CHAR;
  192.   TIMETODO: LONGINT;
  193.   CHARREADCOUNT, CHARWRITECOUNT: LONGINT;
  194.   SYMBOL: ARRAY [LINEINDEX] OF CHAR;
  195.   SYMLEN: 0..MAXLINELEN;
  196.   UNWRITTEN: CHARBUFFER;
  197.   OLDEST: BUFFERINDEX;
  198.   OVERFLOWS, COMOVERFLOWS, FIRSTCOMOVERFLOW, FIRSTOVERFLOW: 0..MAXINT;
  199.   STRINGINDEX: ARRAY [STRINGBLOCKINDEX] OF ^STRINGBLOCK;
  200.   SPACEBEFORE, SPACEAFTER, ALPHANUMERICS, PROGSET, BLOCKBEGSYS, STATSET,
  201.    CONSTANTS, HEADINGBEGSYS, TYPEBEGSYS, EXPRBEGSYS, RELOPS,
  202.   ARITHOPS: SETOFSYMS;
  203.   SYMBOLBREAK: ARRAY [BREAKLEV] OF
  204.       RECORD
  205.         BUFCHAR: INTEGER;
  206.         BREAKCOL: LINEINDEX;
  207.       END;
  208.   SYM, LASTSYM: SYMBOLS;
  209.   INDENTSTATE: ARRAY [LINEINDEX] OF LINEINDEX;
  210.   INDENTLEVEL: LINEINDEX;
  211.   SOURCE, RESULT: TEXT;
  212.   OUTPUTLINE, CURRENTLINE, INPUTLINE, OUTLINELEN, ONEHALFLINE, FIVEEIGHTHLINE,
  213.    BLANKLINES, COLUMN, TABCOLUMN, CHARCOUNT, INITIALBLANKS, STRINGTOP, INDENT,
  214.    PARAGRAFINDENT, STATINDENT, WRITECOL, REMARKCOL, THREEFOURTHLINE,
  215.    TABSPACES, CONTINUESPACES, COMMENTSPACES, STATSPERLINE: INTEGER;
  216.   UCRESWORDS, LCRESWORDS, UCIDENTS, LCIDENTS, EXPORTMODE, SAVINGBLANKS,
  217.    FORMATTING, SYMWRITTEN, ENDLINE, ENDFILE, DOUBLEPERIOD, KILLCOMMENTS,
  218.    INTYPEORVARDCL, INDECLARATION, NEWFORMATTING, BUNCHING, INDIRECTIVES,
  219.    CONVERTTOTABS, SYMBOLFOUND, NEWINPUTLINE: BOOLEAN;
  220.  
  221.  
  222. CONST
  223.   DEFAULTEXT = 'PAS';
  224.  
  225. VAR
  226.   CMDSTRING: STRING [80];
  227.   CMDLINE: STRING [80];
  228.   SOURCEFILENAME, RESULTFILENAME: STRING [8];
  229.   SOURCEEXTENSION, RESULTEXTENSION: STRING [3];
  230.  
  231.  
  232.  
  233. PROCEDURE CSI;
  234.  
  235.   VAR
  236.     I: INTEGER;
  237.  
  238.   BEGIN
  239.     IF PARAMSTR(1) = '/?' THEN
  240.       BEGIN
  241.         WRITELN('   ', REFORMVERSION);
  242.         WRITELN;
  243.         WRITELN;
  244.         WRITELN(' DIR                 Directive Description        Default');
  245.         WRITELN('-----              -------------------------      -------');
  246.         WRITELN('B+/-               BUNCH mode toggle on/off           B-');
  247.         WRITELN('C+/-               CONVERT spaces to tabs             C-');
  248.         WRITELN('F+/-               FORMATTING mode on/off             F+');
  249.         WRITELN('I=x                INDENTATION levels (where');
  250.         WRITELN('                   x is in the range of 1-9)           3');
  251.         WRITELN('K+/-               KILL comments - on/off             K-');
  252.         WRITELN('O=xxx              OUTPUT LINE LENGTH (10-250)        78');
  253.         WRITELN('P=x                PROCEDURE SEPARATION - Lines');
  254.         WRITELN('                   between Procedures/Functions (1-9)  2');
  255.         WRITELN('R+/-               RESERVED word conversion to');
  256.         WRITELN('                   upper or lower case               OFF');
  257.         WRITELN('V+/-               VARIABLE conversion to upper');
  258.         WRITELN('                   or lower case                     OFF');
  259.         WRITELN('X+/-               EXPORTABILITY mode.  Removes');
  260.         WRITELN('                   underscores "_" so programs');
  261.         WRITELN('                   work properly in other dialects');
  262.         WRITELN('                   of Pascal                          X-');
  263.         WRITELN;
  264.         HALT;
  265.       END;
  266.     WRITELN(REFORMVERSION);
  267.     IF PARAMCOUNT > 0 THEN
  268.       CMDLINE := PARAMSTR(1)
  269.     ELSE
  270.       BEGIN
  271.         WRITELN;
  272.         WRITELN('CALLING SEQUENCE IS:');
  273.         WRITELN;
  274.         WRITELN('REFORM <infile>');
  275.         WRITELN;
  276.         WRITELN('For help on formatting directives, type:');
  277.         WRITELN;
  278.         WRITELN('REFORM /?');
  279.         WRITELN;
  280.         HALT;
  281.       END;
  282.     FOR I := 1 TO LENGTH(CMDLINE) DO
  283.       CMDLINE[I] := UPCASE(CMDLINE[I]);
  284.     I := POS('.', CMDLINE);
  285.     IF I = 0 THEN
  286.       BEGIN
  287.         SOURCEFILENAME := CMDLINE;
  288.         SOURCEEXTENSION := DEFAULTEXT;
  289.       END
  290.     ELSE
  291.       BEGIN
  292.         SOURCEFILENAME := COPY(CMDLINE, 1, I - 1);
  293.         SOURCEEXTENSION := COPY(CMDLINE, I + 1, 3);
  294.       END;
  295.     RESULTFILENAME := 'TEMP';
  296.     RESULTEXTENSION := '$$$';
  297.     ASSIGN(SOURCE, SOURCEFILENAME + '.' + SOURCEEXTENSION);
  298.     {$I-}
  299.     RESET(SOURCE);
  300.     {$I+}
  301.     IF IORESULT <> 0 THEN
  302.       BEGIN
  303.         WRITELN;
  304.         WRITELN('Unable to find ', SOURCEFILENAME + '.' + SOURCEEXTENSION,
  305.                 '.');
  306.         HALT;
  307.       END;
  308.     ASSIGN(RESULT, RESULTFILENAME + '.' + RESULTEXTENSION);
  309.     {$I-}
  310.     REWRITE(RESULT);
  311.     {$I+}
  312.   END;
  313.  
  314.  
  315. PROCEDURE INITSETS;
  316.  
  317.   BEGIN
  318.     SPACEBEFORE := [ABSOLUTESYM, ANDSYM, DIVSYM, DOSYM, DOWNTOSYM, INSYM,
  319.                    MODSYM, OFSYM, ORSYM, SHLSYM, SHRSYM, THENSYM, TOSYM,
  320.                    XORSYM, PLUS, MINUS, MULT, DIVIDE, BECOMES, EQUAL, RELOP];
  321.     SPACEAFTER := [ABSOLUTESYM, ANDSYM, ARRAYSYM, CASESYM, DIVSYM, DOWNTOSYM,
  322.                   EXTERNSYM, FORSYM, FUNCTIONSYM, GOTOSYM, IFSYM, INSYM,
  323.                   INLINESYM, MODSYM, NOTSYM, OFSYM, ORSYM, OVERLAYSYM,
  324.                   PACKEDSYM, PROCEDURESYM, PROGRAMSYM, SHLSYM, SHRSYM,
  325.                   STRINGSYM, TOSYM, UNTILSYM, WHILESYM, WITHSYM, XORSYM, PLUS,
  326.                   MINUS, MULT, DIVIDE, BECOMES, COMMA, SEMICOLON, COLON,
  327.                   EQUAL, RELOP, COMMENT];
  328.     ALPHANUMERICS := [ABSOLUTESYM..XORSYM, IDENTIFIER, NUMBER];
  329.     HEADINGBEGSYS := [LABELSYM, USESSYM, CONSTSYM, TYPESYM, VARSYM,
  330.                      OVERLAYSYM, PROCEDURESYM, FUNCTIONSYM];
  331.     BLOCKBEGSYS := HEADINGBEGSYS + [BEGINSYM];
  332.     STATSET := [BEGINSYM, IFSYM, CASESYM, WHILESYM, REPEATSYM, FORSYM,
  333.                WITHSYM, INLINESYM, GOTOSYM, NUMBER, IDENTIFIER];
  334.     CONSTANTS := [NUMBER, IDENTIFIER, STRCONST, PLUS, MINUS, NILSYM];
  335.     EXPRBEGSYS := CONSTANTS + [POINTER, NOTSYM, NILSYM, OPENBRACK, OPENPAREN];
  336.     ARITHOPS := [PLUS, MINUS, MULT, DIVIDE, DIVSYM, MODSYM];
  337.     RELOPS := [EQUAL, RELOP, INSYM];
  338.     TYPEBEGSYS := CONSTANTS + [POINTER, SETSYM, RECORDSYM, FILESYM, ARRAYSYM,
  339.                   OPENPAREN, STRINGSYM] - [NILSYM];
  340.   END;
  341.  
  342.  
  343. FUNCTION TIME: LONGINT;
  344.  
  345.   VAR
  346.     T1, T2, T3, T4: WORD;
  347.  
  348.   BEGIN
  349.     GETTIME(T1, T2, T3, T4);
  350.     TIME := (T1 * 360) + (T2 * 60) + T3;
  351.   END;
  352.  
  353.  
  354. PROCEDURE INITRESVWRD;
  355.  
  356.   BEGIN
  357.     {[B+]}
  358.     RESLEN[2].LOWINDEX := 01; RESLEN[2].HIINDEX := 06;
  359.     RESLEN[3].LOWINDEX := 07; RESLEN[3].HIINDEX := 18;
  360.     RESLEN[4].LOWINDEX := 19; RESLEN[4].HIINDEX := 26;
  361.     RESLEN[5].LOWINDEX := 27; RESLEN[5].HIINDEX := 32;
  362.     RESLEN[6].LOWINDEX := 33; RESLEN[6].HIINDEX := 38;
  363.     RESLEN[7].LOWINDEX := 39; RESLEN[7].HIINDEX := 41;
  364.     RESLEN[8].LOWINDEX := 42; RESLEN[8].HIINDEX := 44;
  365.     RESLEN[9].LOWINDEX := 45; RESLEN[9].HIINDEX := 45;
  366.     RESVWRD[01] := 'do       '; RESSYMBOL[01] := DOSYM;
  367.     RESVWRD[02] := 'if       '; RESSYMBOL[02] := IFSYM;
  368.     RESVWRD[03] := 'in       '; RESSYMBOL[03] := INSYM;
  369.     RESVWRD[04] := 'of       '; RESSYMBOL[04] := OFSYM;
  370.     RESVWRD[05] := 'or       '; RESSYMBOL[05] := ORSYM;
  371.     RESVWRD[06] := 'to       '; RESSYMBOL[06] := TOSYM;
  372.     RESVWRD[07] := 'and      '; RESSYMBOL[07] := ANDSYM;
  373.     RESVWRD[08] := 'div      '; RESSYMBOL[08] := DIVSYM;
  374.     RESVWRD[09] := 'end      '; RESSYMBOL[09] := ENDSYM;
  375.     RESVWRD[10] := 'for      '; RESSYMBOL[10] := FORSYM;
  376.     RESVWRD[11] := 'mod      '; RESSYMBOL[11] := MODSYM;
  377.     RESVWRD[12] := 'nil      '; RESSYMBOL[12] := NILSYM;
  378.     RESVWRD[13] := 'not      '; RESSYMBOL[13] := NOTSYM;
  379.     RESVWRD[14] := 'set      '; RESSYMBOL[14] := SETSYM;
  380.     RESVWRD[15] := 'shl      '; RESSYMBOL[15] := SHLSYM;
  381.     RESVWRD[16] := 'shr      '; RESSYMBOL[16] := SHRSYM;
  382.     RESVWRD[17] := 'var      '; RESSYMBOL[17] := VARSYM;
  383.     RESVWRD[18] := 'xor      '; RESSYMBOL[18] := XORSYM;
  384.     RESVWRD[19] := 'case     '; RESSYMBOL[19] := CASESYM;
  385.     RESVWRD[20] := 'else     '; RESSYMBOL[20] := ELSESYM;
  386.     RESVWRD[21] := 'file     '; RESSYMBOL[21] := FILESYM;
  387.     RESVWRD[22] := 'goto     '; RESSYMBOL[22] := GOTOSYM;
  388.     RESVWRD[23] := 'then     '; RESSYMBOL[23] := THENSYM;
  389.     RESVWRD[24] := 'type     '; RESSYMBOL[24] := TYPESYM;
  390.     RESVWRD[25] := 'uses     '; RESSYMBOL[25] := USESSYM;
  391.     RESVWRD[26] := 'with     '; RESSYMBOL[26] := WITHSYM;
  392.     RESVWRD[27] := 'array    '; RESSYMBOL[27] := ARRAYSYM;
  393.     RESVWRD[28] := 'begin    '; RESSYMBOL[28] := BEGINSYM;
  394.     RESVWRD[29] := 'const    '; RESSYMBOL[29] := CONSTSYM;
  395.     RESVWRD[30] := 'label    '; RESSYMBOL[30] := LABELSYM;
  396.     RESVWRD[31] := 'until    '; RESSYMBOL[31] := UNTILSYM;
  397.     RESVWRD[32] := 'while    '; RESSYMBOL[32] := WHILESYM;
  398.     RESVWRD[33] := 'downto   '; RESSYMBOL[33] := DOWNTOSYM;
  399.     RESVWRD[34] := 'inline   '; RESSYMBOL[34] := INLINESYM;
  400.     RESVWRD[35] := 'packed   '; RESSYMBOL[35] := PACKEDSYM;
  401.     RESVWRD[36] := 'record   '; RESSYMBOL[36] := RECORDSYM;
  402.     RESVWRD[37] := 'repeat   '; RESSYMBOL[37] := REPEATSYM;
  403.     RESVWRD[38] := 'string   '; RESSYMBOL[38] := STRINGSYM;
  404.     RESVWRD[39] := 'forward  '; RESSYMBOL[39] := FORWARDSYM;
  405.     RESVWRD[40] := 'overlay  '; RESSYMBOL[40] := OVERLAYSYM;
  406.     RESVWRD[41] := 'program  '; RESSYMBOL[41] := PROGRAMSYM;
  407.     RESVWRD[42] := 'absolute '; RESSYMBOL[42] := ABSOLUTESYM;
  408.     RESVWRD[43] := 'external '; RESSYMBOL[43] := EXTERNSYM;
  409.     RESVWRD[44] := 'function '; RESSYMBOL[44] := FUNCTIONSYM;
  410.     RESVWRD[45] := 'procedure'; RESSYMBOL[45] := PROCEDURESYM;
  411.     {[B-]}
  412.   END;
  413.  
  414.  
  415. PROCEDURE INITIALIZE;
  416.  
  417.   VAR
  418.     P: INTEGER;
  419.     C: CHAR;
  420.     S: STRINGBLOCKINDEX;
  421.  
  422.   BEGIN
  423.     TIMETODO := TIME;
  424.     INITSETS;
  425.     FOR C := CHR(0) TO CHR(127) DO
  426.       BEGIN
  427.         LOWERCASE[C] := C;
  428.         UPPERCASE[C] := C;
  429.       END;
  430.     FOR C := 'A' TO 'Z' DO
  431.       BEGIN
  432.         LOWERCASE[C] := CHR(ORD(C) + ORD('a') - ORD('A'));
  433.         UPPERCASE[CHR(ORD(C) + ORD('a') - ORD('A'))] := C;
  434.       END;
  435.     CHARCOUNT := 0;
  436.     OUTLINELEN := DEFAULTOUTLINE;
  437.     TABSPACES := DEFAULTTABSPACES;
  438.     CONTINUESPACES := (TABSPACES + 1) DIV 2;
  439.     COMMENTSPACES := DEFAULTCOMMENTSPACES;
  440.     INDENTLEVEL := 0;
  441.     ONEHALFLINE := OUTLINELEN DIV 2;
  442.     FIVEEIGHTHLINE := 5 * OUTLINELEN DIV 8;
  443.     THREEFOURTHLINE := 3 * OUTLINELEN DIV 4;
  444.     STATSPERLINE := 1;
  445.     FOR P := 1 TO OUTLINELEN DO
  446.       SYMBOL[P] := ' ';
  447.     SYMLEN := 0;
  448.     INDENT := 0;
  449.     PARAGRAFINDENT := 1;
  450.     STATINDENT := 0;
  451.     WRITECOL := 0;
  452.     REMARKCOL := 40;
  453.     SAVINGBLANKS := FALSE;
  454.     COLUMN := 0;
  455.     TABCOLUMN := 0;
  456.     OUTPUTLINE := 1;
  457.     CURRENTLINE := 0;
  458.     INPUTLINE := 1;
  459.     CHARREADCOUNT := 0;
  460.     CHARWRITECOUNT := 0;
  461.     NEWINPUTLINE := TRUE;
  462.     BLANKLINES := 0;
  463.     SYM := PERIOD;
  464.     KILLCOMMENTS := FALSE;
  465.     INDIRECTIVES := FALSE;
  466.     ENDLINE := FALSE;
  467.     ENDFILE := FALSE;
  468.     LASTSYM := PERIOD;
  469.     SYMWRITTEN := FALSE;
  470.     CH := ' ';
  471.     PREVCH := ' ';
  472.     INTYPEORVARDCL := FALSE;
  473.     INDECLARATION := FALSE;
  474.     DOUBLEPERIOD := FALSE;
  475.     FORMATTING := TRUE;
  476.     NEWFORMATTING := TRUE;
  477.     UCRESWORDS := FALSE;
  478.     LCRESWORDS := FALSE;
  479.     UCIDENTS := FALSE;
  480.     LCIDENTS := FALSE;
  481.     EXPORTMODE := FALSE;
  482.     BUNCHING := FALSE;
  483.     CONVERTTOTABS := FALSE;
  484.     OVERFLOWS := 0;
  485.     COMOVERFLOWS := 0;
  486.     INITRESVWRD;
  487.     FOR S := 0 TO STRINGINDEXMAX DO
  488.       STRINGINDEX[S] := NIL;
  489.     STRINGTOP := 0;
  490.   END;
  491.  
  492.  
  493. PROCEDURE BACKUPSOURCE;
  494.  
  495.   VAR
  496.     F: TEXT;
  497.  
  498.   BEGIN
  499.     ASSIGN(F, SOURCEFILENAME + '.OLD');
  500.     {$I-}
  501.     RESET(F);
  502.     {$I+}
  503.     IF IORESULT = 0 THEN
  504.       BEGIN
  505.         CLOSE(F);
  506.         ERASE(F);
  507.       END;
  508.     RENAME(SOURCE, SOURCEFILENAME + '.OLD');
  509.   END;
  510.  
  511.  
  512. PROCEDURE QUIT;
  513.  
  514.   VAR
  515.     SECONDS: LONGINT;
  516.  
  517.   BEGIN
  518.     CLOSE(SOURCE);
  519.     CLOSE(RESULT);
  520.     BACKUPSOURCE;
  521.     RENAME(RESULT, SOURCEFILENAME + '.' + SOURCEEXTENSION);
  522.     IF OVERFLOWS > 0 THEN
  523.       BEGIN
  524.         WRITE('Line too wide to output in ', OVERFLOWS: 1, ' place');
  525.         IF OVERFLOWS > 1 THEN
  526.           WRITE('s');
  527.         WRITELN('.');
  528.         WRITELN('The first error was on line ', FIRSTOVERFLOW: 1, '.');
  529.       END;
  530.     IF COMOVERFLOWS > 0 THEN
  531.       BEGIN
  532.         WRITE('Comment too wide to output in ', COMOVERFLOWS: 1, ' place');
  533.         IF COMOVERFLOWS > 1 THEN
  534.           WRITE('s');
  535.         WRITELN('.');
  536.         WRITELN('The first error was on line ', FIRSTCOMOVERFLOW: 1, '.');
  537.       END;
  538.     SECONDS := TIME - TIMETODO;
  539.     WRITELN('REFORM complete.');
  540.     WRITELN;
  541.     WRITE('Time to complete: ');
  542.     IF SECONDS > 60 THEN
  543.       BEGIN
  544.         WRITE(SECONDS DIV 60, ' minute');
  545.         IF (SECONDS DIV 60 > 1) THEN
  546.           WRITE('s');
  547.         WRITE(SECONDS MOD 60);
  548.       END
  549.     ELSE
  550.       WRITE(SECONDS);
  551.     WRITE(' second');
  552.     IF SECONDS > 1 THEN
  553.       WRITE('s');
  554.     WRITELN('.');
  555.     WRITELN;
  556.     WRITE(INPUTLINE - 1: 1, ' line');
  557.     IF INPUTLINE - 1 > 1 THEN
  558.       WRITE('s');
  559.     WRITELN(' (', CHARREADCOUNT: 1, ' characters) read.');
  560.     WRITE(OUTPUTLINE - 1: 1, ' line');
  561.     IF OUTPUTLINE > 2 THEN
  562.       WRITE('s');
  563.     WRITELN(' (', CHARWRITECOUNT + 1: 1, ' characters) written.');
  564.   END;
  565.  
  566.  
  567. PROCEDURE CLEARBREAKS;
  568.  
  569.   VAR
  570.     I: BREAKLEV;
  571.  
  572.   BEGIN
  573.     FOR I := 0 TO MAXBREAKLEVEL DO
  574.       SYMBOLBREAK[I].BUFCHAR := 0;
  575.   END;
  576.  
  577.  
  578. PROCEDURE RESETCHARCOUNT;
  579.  
  580.   BEGIN
  581.     IF CHARCOUNT > BUFSIZEP1 THEN
  582.       CHARCOUNT := CHARCOUNT MOD BUFSIZE + 2 * BUFSIZE;
  583.     CLEARBREAKS;
  584.   END;
  585.  
  586.  
  587. PROCEDURE WRITEA(CH: CHAR);
  588.  
  589.   VAR
  590.     I: LINEINDEX;
  591.  
  592.   BEGIN
  593.     CHARCOUNT := CHARCOUNT + 1;
  594.     OLDEST := CHARCOUNT MOD BUFSIZE;
  595.     WITH UNWRITTEN[OLDEST] DO
  596.       BEGIN
  597.         IF CHARCOUNT >= BUFSIZEP1 THEN
  598.           IF ACTIONIS = GRAPHIC THEN
  599.             BEGIN
  600.               IF SAVINGBLANKS THEN
  601.                 IF CHARACTER = ' ' THEN
  602.                   INITIALBLANKS := INITIALBLANKS + 1
  603.                 ELSE
  604.                   BEGIN
  605.                     WHILE CONVERTTOTABS AND (INITIALBLANKS >= TABINTERVAL) DO
  606.                       BEGIN
  607.                         WRITE(RESULT, CHR(HT));
  608.                         CHARWRITECOUNT := CHARWRITECOUNT + 1;
  609.                         INITIALBLANKS := INITIALBLANKS - TABINTERVAL;
  610.                       END;
  611.                     WHILE INITIALBLANKS > 0 DO
  612.                       BEGIN
  613.                         WRITE(RESULT, ' ');
  614.                         CHARWRITECOUNT := CHARWRITECOUNT + 1;
  615.                         INITIALBLANKS := INITIALBLANKS - 1;
  616.                       END;
  617.                     SAVINGBLANKS := FALSE;
  618.                     WRITE(RESULT, CHARACTER);
  619.                     CHARWRITECOUNT := CHARWRITECOUNT + 1;
  620.                   END
  621.               ELSE
  622.                 BEGIN
  623.                   WRITE(RESULT, CHARACTER);
  624.                   CHARWRITECOUNT := CHARWRITECOUNT + 1;
  625.                 END
  626.             END
  627.           ELSE IF ACTIONIS = SPACES THEN
  628.             BEGIN
  629.               IF SAVINGBLANKS THEN
  630.                 INITIALBLANKS := INITIALBLANKS + SPACING
  631.               ELSE
  632.                 FOR I := 1 TO SPACING DO
  633.                   BEGIN
  634.                     WRITE(RESULT, ' ');
  635.                     CHARWRITECOUNT := CHARWRITECOUNT + 1;
  636.                   END;
  637.             END
  638.           ELSE
  639.             BEGIN
  640.               IF CHARCOUNT > BUFSIZEP1 THEN
  641.                 BEGIN
  642.                   WRITELN(RESULT);
  643.                   CHARWRITECOUNT := CHARWRITECOUNT + 1;
  644.                 END;
  645.               SAVINGBLANKS := TRUE;
  646.               INITIALBLANKS := SPACING;
  647.               OUTPUTLINE := OUTPUTLINE + 1;
  648.             END;
  649.         ACTIONIS := GRAPHIC;
  650.         CHARACTER := CH;
  651.         IF CH = CHR(HT) THEN
  652.           WRITECOL := ((WRITECOL + TABINTERVAL) DIV TABINTERVAL) * TABINTERVAL
  653.         ELSE
  654.           WRITECOL := WRITECOL + 1;
  655.       END;
  656.   END;
  657.  
  658.  
  659. PROCEDURE NEWLINE(INDENT: LINEINDEX);
  660.  
  661.   BEGIN
  662.     ENDLINE := FALSE;
  663.     WRITEA(' ');
  664.     WITH UNWRITTEN[OLDEST] DO
  665.       BEGIN
  666.         ACTIONIS := BEGINLINE;
  667.         SPACING := INDENT;
  668.       END;
  669.     WRITECOL := INDENT;
  670.     CURRENTLINE := CURRENTLINE + 1;
  671.   END;
  672.  
  673.  
  674. PROCEDURE PRINTLINE(INDENT: INTEGER);
  675.  
  676.   BEGIN
  677.     IF FORMATTING THEN
  678.       BEGIN
  679.         WHILE (BLANKLINES > 0) AND (CURRENTLINE > 0) DO
  680.           BEGIN
  681.             NEWLINE(0);
  682.             BLANKLINES := 0;
  683.           END;
  684.         NEWLINE(INDENT);
  685.       END;
  686.     BLANKLINES := 0;
  687.     CLEARBREAKS;
  688.   END;
  689.  
  690.  
  691. PROCEDURE SPACE(N: INTEGER);
  692.  
  693.   BEGIN
  694.     IF FORMATTING THEN
  695.       BEGIN
  696.         WRITEA(' ');
  697.         WITH UNWRITTEN[OLDEST] DO
  698.           BEGIN
  699.             ACTIONIS := SPACES;
  700.             IF N >= 0 THEN
  701.               SPACING := N
  702.             ELSE
  703.               SPACING := 0;
  704.           END;
  705.         WRITECOL := WRITECOL + N - 1;
  706.       END;
  707.   END;
  708.  
  709.  
  710. PROCEDURE FLUSHBUFFER;
  711.  
  712.   VAR
  713.     I: 0..BUFSIZEM1;
  714.  
  715.   BEGIN
  716.     FOR I := 0 TO BUFSIZEM1 DO
  717.       WRITEA(' ');
  718.     WRITELN(RESULT);
  719.   END;
  720.  
  721.  
  722. PROCEDURE FLUSHSYMBOL;
  723.  
  724.   VAR
  725.     P: LINEINDEX;
  726.  
  727.   BEGIN
  728.     IF NOT SYMWRITTEN THEN
  729.       FOR P := 1 TO SYMLEN DO
  730.         WRITEA(SYMBOL[P]);
  731.   END;
  732.  
  733.  
  734. PROCEDURE CHUCKIT(CH: CHAR);
  735.  
  736.   BEGIN
  737.   END;
  738.  
  739.  
  740. PROCEDURE GETCHAR;
  741.  
  742.   BEGIN
  743.     IF COLUMN < TABCOLUMN THEN
  744.       BEGIN
  745.         COLUMN := COLUMN + 1;
  746.         CH := ' ';
  747.         IF NOT FORMATTING THEN
  748.           WRITEA(' ');
  749.       END
  750.     ELSE IF NOT EOF(SOURCE) THEN
  751.       IF NOT EOLN(SOURCE) THEN
  752.         BEGIN
  753.           READ(SOURCE, CH);
  754.           IF (LENGTH(CH) <> 0) AND (CH <> #13) THEN
  755.             BEGIN
  756.               CHARREADCOUNT := CHARREADCOUNT + 1;
  757.               IF CH = CHR(HT) THEN
  758.                 BEGIN
  759.                   TABCOLUMN := ((COLUMN + TABINTERVAL) DIV TABINTERVAL) *
  760.                                TABINTERVAL;
  761.                   CH := ' ';
  762.                 END;
  763.               IF NOT FORMATTING THEN
  764.                 WRITEA(CH);
  765.               COLUMN := COLUMN + 1;
  766.             END;
  767.         END
  768.       ELSE
  769.         BEGIN
  770.           IF NOT (NEWINPUTLINE) THEN
  771.             NEWINPUTLINE := TRUE;
  772.           COLUMN := 0;
  773.           TABCOLUMN := 0;
  774.           INPUTLINE := INPUTLINE + 1;
  775.           READLN(SOURCE);
  776.           CHARREADCOUNT := CHARREADCOUNT + 1;
  777.           IF NOT FORMATTING THEN
  778.             BEGIN
  779.               NEWLINE(0);
  780.               RESETCHARCOUNT;
  781.             END;
  782.           CH := ' ';
  783.         END
  784.     ELSE
  785.       BEGIN
  786.         ENDFILE := TRUE;
  787.         CH := ' ';
  788.       END
  789.   END;
  790.  
  791.  
  792. PROCEDURE LINEOVERFLOW;
  793.  
  794.   BEGIN
  795.     OVERFLOWS := OVERFLOWS + 1;
  796.     IF OVERFLOWS = 1 THEN
  797.       FIRSTOVERFLOW := CURRENTLINE + 1;
  798.   END;
  799.  
  800.  
  801. PROCEDURE COMMENTOVERFLOW;
  802.  
  803.   BEGIN
  804.     COMOVERFLOWS := COMOVERFLOWS + 1;
  805.     IF COMOVERFLOWS = 1 THEN
  806.       FIRSTCOMOVERFLOW := CURRENTLINE;
  807.   END;
  808.  
  809.  
  810. PROCEDURE ABORT(KIND: ABORTKIND);
  811.  
  812.   BEGIN
  813.     FLUSHSYMBOL;
  814.     WRITEA(CH);
  815.     WRITELN;
  816.     IF KIND = SYNTAX THEN
  817.       WRITE('Syntax error detected, ')
  818.     ELSE IF KIND = NESTING THEN
  819.       WRITE('too many indentation levels, ')
  820.     ELSE
  821.       WRITE('could not format comment, ');
  822.     WRITELN('processing aborted at line ', INPUTLINE: 1);
  823.     CLOSE(RESULT);
  824.     HALT;
  825.   END;
  826.  
  827.  
  828. PROCEDURE INDENTPLUS(DELTA: INTEGER);
  829.  
  830.   BEGIN
  831.     IF INDENTLEVEL > MAXLINELEN THEN
  832.       ABORT(NESTING);
  833.     INDENTLEVEL := INDENTLEVEL + 1;
  834.     INDENTSTATE[INDENTLEVEL] := INDENT;
  835.     INDENT := INDENT + DELTA;
  836.     IF INDENT > OUTLINELEN THEN
  837.       INDENT := OUTLINELEN
  838.     ELSE IF INDENT < 0 THEN
  839.       INDENT := 0;
  840.   END;
  841.  
  842.  
  843. PROCEDURE UNDENT;
  844.  
  845.   BEGIN
  846.     INDENT := INDENTSTATE[INDENTLEVEL];
  847.     INDENTLEVEL := INDENTLEVEL - 1;
  848.   END;
  849.  
  850.  
  851. PROCEDURE SETSYMBOLBREAK(LEVEL: BREAKLEV);
  852.  
  853.   BEGIN
  854.     SPACE(0);
  855.     WITH SYMBOLBREAK[LEVEL] DO
  856.       BEGIN
  857.         BUFCHAR := CHARCOUNT;
  858.         BREAKCOL := WRITECOL;
  859.       END;
  860.   END;
  861.  
  862.  
  863. PROCEDURE FORMATLINE(INDENT: INTEGER);
  864.  
  865.   BEGIN
  866.     PRINTLINE(INDENT);
  867.   END;
  868.  
  869.  
  870. PROCEDURE MAKEWHITE;
  871.  
  872.   BEGIN
  873.     IF FORMATTING AND (BLANKLINES = 0) THEN
  874.       BLANKLINES := 1;
  875.   END;
  876.  
  877.  
  878. PROCEDURE PUTSYM;
  879.  
  880.   VAR
  881.     BEFORE: LINEINDEX;
  882.     SYMINDENT: INTEGER;
  883.     I: LINEINDEX;
  884.     L: BREAKLEV;
  885.     LASTBREAK: INTEGER;
  886.  
  887.  
  888.  
  889.   FUNCTION SPACESBEFORE(THISSYM, OLDSYM: SYMBOLS): LINEINDEX;
  890.  
  891.     BEGIN
  892.       IF ((THISSYM IN ALPHANUMERICS) AND (OLDSYM IN ALPHANUMERICS)) OR
  893.          (THISSYM IN SPACEBEFORE) OR (OLDSYM IN SPACEAFTER) THEN
  894.         SPACESBEFORE := 1
  895.       ELSE
  896.         SPACESBEFORE := 0;
  897.     END;
  898.   BEGIN
  899.     BEFORE := SPACESBEFORE(SYM, LASTSYM);
  900.     IF ENDLINE OR (BEFORE + SYMLEN + WRITECOL > OUTLINELEN) THEN
  901.       BEGIN
  902.         L := MAXBREAKLEVEL;
  903.         WHILE (L > 0) AND (SYMBOLBREAK[L].BUFCHAR = 0) DO
  904.           L := L - 1;
  905.         WITH SYMBOLBREAK[L] DO
  906.           IF NOT ENDLINE AND FORMATTING AND (BUFCHAR > 0) AND
  907.              (CHARCOUNT - BUFCHAR < BUFSIZE) AND
  908.              (BEFORE + SYMLEN + INDENT + WRITECOL - BREAKCOL <=
  909.              OUTLINELEN) THEN
  910.             BEGIN
  911.               WITH UNWRITTEN[BUFCHAR MOD BUFSIZE] DO
  912.                 BEGIN
  913.                   ACTIONIS := BEGINLINE;
  914.                   SPACING := INDENT
  915.                 END;
  916.               WRITECOL := WRITECOL - BREAKCOL + INDENT;
  917.               CURRENTLINE := CURRENTLINE + 1;
  918.               LASTBREAK := BUFCHAR;
  919.             END
  920.           ELSE
  921.             BEGIN
  922.               SYMINDENT := OUTLINELEN - SYMLEN;
  923.               IF SYMINDENT > INDENT THEN
  924.                 SYMINDENT := INDENT
  925.               ELSE IF SYMINDENT < 0 THEN
  926.                 BEGIN
  927.                   SYMINDENT := 0;
  928.                   LINEOVERFLOW
  929.                 END;
  930.               PRINTLINE(SYMINDENT);
  931.               LASTBREAK := CHARCOUNT;
  932.             END;
  933.         FOR L := 0 TO MAXBREAKLEVEL DO
  934.           WITH SYMBOLBREAK[L] DO
  935.             IF BUFCHAR <= LASTBREAK THEN
  936.               BUFCHAR := 0;
  937.       END;
  938.     IF UNWRITTEN[OLDEST].ACTIONIS = BEGINLINE THEN
  939.       BEFORE := 0;
  940.     IF BEFORE > 0 THEN
  941.       WITH UNWRITTEN[CHARCOUNT MOD BUFSIZE] DO
  942.         IF FORMATTING AND (ACTIONIS = SPACES) THEN
  943.           BEGIN
  944.             WRITECOL := WRITECOL - SPACING + BEFORE;
  945.             SPACING := BEFORE;
  946.           END
  947.         ELSE
  948.           SPACE(BEFORE);
  949.     IF FORMATTING THEN
  950.       FOR I := 1 TO SYMLEN DO
  951.         WRITEA(SYMBOL[I]);
  952.     LASTSYM := SYM;
  953.     SYMWRITTEN := TRUE;
  954.     ENDLINE := FALSE;
  955.   END;
  956.  
  957.  
  958. PROCEDURE BLOCKCOMCHAR(CHARACTER: CHAR);
  959.   FORWARD;
  960.  
  961.  
  962. PROCEDURE STATCOMCHAR(CHARACTER: CHAR);
  963.   FORWARD;
  964.  
  965.  
  966. PROCEDURE DOCOMPILERDIRECTIVES(PUTCHIDX: INTEGER);
  967.  
  968.  
  969.   PROCEDURE COPYIT;
  970.  
  971.     BEGIN
  972.       CASE PUTCHIDX OF
  973.         1: BLOCKCOMCHAR(CH);
  974.         2: STATCOMCHAR(CH);
  975.       END;
  976.       GETCHAR;
  977.     END;
  978.   BEGIN
  979.     INDIRECTIVES := TRUE;
  980.     IF KILLCOMMENTS THEN
  981.       BEGIN
  982.         IF PREVCH = '{' THEN
  983.           WRITEA('{')
  984.         ELSE
  985.           BEGIN
  986.             WRITEA('(');
  987.             WRITEA('*');
  988.           END;
  989.         PREVCH := ' ';
  990.       END;
  991.     REPEAT
  992.       IF (CH <> '}') AND (CH <> '*') THEN
  993.         COPYIT;
  994.     UNTIL CH IN ['}', '*'];
  995.   END;
  996.  
  997.  
  998. PROCEDURE DOFORMATTERDIRECTIVES(PUTCHIDX: INTEGER);
  999.  
  1000.   VAR
  1001.     TEMPFLAG: BOOLEAN;
  1002.     OPTCHAR: CHAR;
  1003.  
  1004.  
  1005.  
  1006.   PROCEDURE COPYACHAR;
  1007.  
  1008.     BEGIN
  1009.       CASE PUTCHIDX OF
  1010.         1: BLOCKCOMCHAR(CH);
  1011.         2: STATCOMCHAR(CH);
  1012.       END;
  1013.       GETCHAR;
  1014.     END;
  1015.  
  1016.  
  1017.   PROCEDURE TOGGLE(VAR SWITCH: BOOLEAN);
  1018.  
  1019.     BEGIN
  1020.       CASE CH OF
  1021.         '+':
  1022.           BEGIN
  1023.             SWITCH := TRUE;
  1024.             COPYACHAR;
  1025.           END;
  1026.         '-':
  1027.           BEGIN
  1028.             SWITCH := FALSE;
  1029.             COPYACHAR;
  1030.           END;
  1031.       END;
  1032.     END;
  1033.  
  1034.  
  1035.   PROCEDURE NUMDIR(VAR VALUE: INTEGER;
  1036.                    MIN, MAX: INTEGER);
  1037.  
  1038.     VAR
  1039.       TEMPVAL: INTEGER;
  1040.  
  1041.     BEGIN
  1042.       IF CH = '=' THEN
  1043.         COPYACHAR;
  1044.       IF (CH >= '0') AND (CH <= '9') THEN
  1045.         BEGIN
  1046.           TEMPVAL := 0;
  1047.           WHILE (CH >= '0') AND (CH <= '9') DO
  1048.             BEGIN
  1049.               IF TEMPVAL <= (MAXINT - 9) DIV 10 THEN
  1050.                 TEMPVAL := TEMPVAL * 10 + (ORD(CH) - ORD('0'));
  1051.               COPYACHAR;
  1052.             END;
  1053.           IF TEMPVAL < MIN THEN
  1054.             TEMPVAL := MIN;
  1055.           IF TEMPVAL > MAX THEN
  1056.             TEMPVAL := MAX;
  1057.           VALUE := TEMPVAL;
  1058.         END;
  1059.     END;
  1060.   BEGIN
  1061.     INDIRECTIVES := TRUE;
  1062.     IF KILLCOMMENTS THEN
  1063.       BEGIN
  1064.         IF PREVCH = '{' THEN
  1065.           WRITEA('{')
  1066.         ELSE
  1067.           BEGIN
  1068.             WRITEA('(');
  1069.             WRITEA('*');
  1070.           END;
  1071.         PREVCH := ' ';
  1072.       END;
  1073.     COPYACHAR;
  1074.     REPEAT
  1075.       IF (CH <> ']') AND (CH <> '}') AND (CH <> '*') THEN
  1076.         BEGIN
  1077.           OPTCHAR := CH;
  1078.           COPYACHAR;
  1079.           CASE OPTCHAR OF
  1080.             'b', 'B':
  1081.               BEGIN
  1082.                 TOGGLE(BUNCHING);
  1083.                 IF BUNCHING THEN
  1084.                   STATSPERLINE := MAXLINELEN
  1085.                 ELSE
  1086.                   STATSPERLINE := 1;
  1087.               END;
  1088.             'c', 'C': TOGGLE(CONVERTTOTABS);
  1089.             'f', 'F': TOGGLE(NEWFORMATTING);
  1090.             'i', 'I':
  1091.               BEGIN
  1092.                 NUMDIR(TABSPACES, 1, 9);
  1093.                 CONTINUESPACES := (TABSPACES + 1) DIV 2;
  1094.               END;
  1095.             'k', 'K': TOGGLE(KILLCOMMENTS);
  1096.             'o', 'O':
  1097.               BEGIN
  1098.                 NUMDIR(OUTLINELEN, 1, MAXLINELEN);
  1099.                 ONEHALFLINE := OUTLINELEN DIV 2;
  1100.                 FIVEEIGHTHLINE := (5 * OUTLINELEN) DIV 8;
  1101.                 THREEFOURTHLINE := (3 * OUTLINELEN) DIV 4;
  1102.               END;
  1103.             'p', 'P': NUMDIR(PARAGRAFINDENT, 1, 9);
  1104.             'r', 'R':
  1105.               BEGIN
  1106.                 TOGGLE(UCRESWORDS);
  1107.                 LCRESWORDS := NOT (UCRESWORDS);
  1108.               END;
  1109.             'v', 'V':
  1110.               BEGIN
  1111.                 TOGGLE(UCIDENTS);
  1112.                 LCIDENTS := NOT (UCIDENTS);
  1113.               END;
  1114.             'x', 'X': TOGGLE(EXPORTMODE);
  1115.             ELSE;
  1116.           END;
  1117.         END;
  1118.     UNTIL (CH = ']') OR (CH = '}') OR (CH = '*');
  1119.     IF CH = ']' THEN
  1120.       COPYACHAR;
  1121.   END;
  1122.  
  1123. VAR
  1124.   STATBREAK: INTEGER;
  1125.   STATBLANKS: BOOLEAN;
  1126.   FIRSTINPUTLINE: BOOLEAN;
  1127.  
  1128.  
  1129.  
  1130. PROCEDURE BLOCKCOMCHAR;
  1131.  
  1132.   BEGIN
  1133.     IF ENDFILE THEN
  1134.       ABORT(SYNTAX);
  1135.     IF (NOT KILLCOMMENTS) OR (INDIRECTIVES) THEN
  1136.       BEGIN
  1137.         IF FORMATTING THEN
  1138.           IF NEWINPUTLINE AND (CHARACTER = ' ') THEN
  1139.             BEGIN
  1140.               IF WRITECOL > OUTLINELEN THEN
  1141.                 COMMENTOVERFLOW;
  1142.               PRINTLINE(COLUMN);
  1143.               FIRSTINPUTLINE := FALSE;
  1144.               NEWINPUTLINE := FALSE;
  1145.             END
  1146.           ELSE
  1147.             WRITEA(CHARACTER);
  1148.       END;
  1149.   END;
  1150.  
  1151.  
  1152. PROCEDURE BREAKSTATCOMMENT;
  1153.  
  1154.   VAR
  1155.     EXTRALEN: INTEGER;
  1156.     COMINDENT: INTEGER;
  1157.  
  1158.   BEGIN
  1159.     EXTRALEN := CHARCOUNT - STATBREAK + 1;
  1160.     IF WRITECOL - EXTRALEN > MAXLINELEN THEN
  1161.       ABORT(COMFORMAT)
  1162.     ELSE
  1163.       BEGIN
  1164.         IF WRITECOL - EXTRALEN > OUTLINELEN THEN
  1165.           COMMENTOVERFLOW;
  1166.         COMINDENT := OUTLINELEN - EXTRALEN;
  1167.         IF COMINDENT < 0 THEN
  1168.           COMINDENT := 0
  1169.         ELSE IF COMINDENT > REMARKCOL THEN
  1170.           COMINDENT := REMARKCOL;
  1171.         WITH UNWRITTEN[STATBREAK MOD BUFSIZE] DO
  1172.           BEGIN
  1173.             ACTIONIS := BEGINLINE;
  1174.             SPACING := COMINDENT;
  1175.           END;
  1176.         CURRENTLINE := CURRENTLINE + 1;
  1177.         WRITECOL := COMINDENT + EXTRALEN;
  1178.       END;
  1179.   END;
  1180.  
  1181.  
  1182. PROCEDURE STATCOMCHAR;
  1183.  
  1184.   BEGIN
  1185.     IF ENDFILE THEN
  1186.       ABORT(SYNTAX);
  1187.     IF (NOT KILLCOMMENTS) OR (INDIRECTIVES) THEN
  1188.       BEGIN
  1189.         IF FORMATTING THEN
  1190.           IF CHARACTER = ' ' THEN
  1191.             BEGIN
  1192.               IF NOT STATBLANKS THEN
  1193.                 BEGIN
  1194.                   IF (WRITECOL > OUTLINELEN) AND (STATBREAK <> 0) THEN
  1195.                     BREAKSTATCOMMENT;
  1196.                   WRITEA(' ');
  1197.                   STATBREAK := CHARCOUNT;
  1198.                   STATBLANKS := TRUE;
  1199.                 END;
  1200.             END
  1201.           ELSE
  1202.             BEGIN
  1203.               WRITEA(CHARACTER);
  1204.               STATBLANKS := FALSE;
  1205.             END;
  1206.       END;
  1207.   END;
  1208.  
  1209.  
  1210. PROCEDURE DOCOMMENT(BLOCK: BOOLEAN;
  1211.                     INITCOL: LINEINDEX;
  1212.                     INITCHAR: CHAR);
  1213.  
  1214.  
  1215.   PROCEDURE ADJUSTBLOCKCOMMENT(START: INTEGER);
  1216.  
  1217.     VAR
  1218.       COMLENGTH: INTEGER;
  1219.       COMINDENT: INTEGER;
  1220.  
  1221.     BEGIN
  1222.       IF FORMATTING THEN
  1223.         BEGIN
  1224.           IF FIRSTINPUTLINE THEN
  1225.             BEGIN
  1226.               COMLENGTH := CHARCOUNT - START;
  1227.               COMINDENT := OUTLINELEN - COMLENGTH;
  1228.               IF COMINDENT < 0 THEN
  1229.                 COMINDENT := 0
  1230.               ELSE IF COMINDENT > STATINDENT THEN
  1231.                 COMINDENT := STATINDENT;
  1232.               UNWRITTEN[START MOD BUFSIZE].SPACING := COMINDENT;
  1233.               WRITECOL := COMINDENT + COMLENGTH;
  1234.             END;
  1235.           IF WRITECOL > OUTLINELEN THEN
  1236.             COMMENTOVERFLOW;
  1237.         END;
  1238.     END;
  1239.  
  1240.  
  1241.   PROCEDURE ADJUSTSTATCOMMENT;
  1242.  
  1243.     BEGIN
  1244.       IF FORMATTING THEN
  1245.         IF WRITECOL > OUTLINELEN THEN
  1246.           IF STATBREAK = 0 THEN
  1247.             IF WRITECOL <= MAXLINELEN THEN
  1248.               COMMENTOVERFLOW
  1249.             ELSE
  1250.               ABORT(COMFORMAT)
  1251.           ELSE
  1252.             BREAKSTATCOMMENT;
  1253.     END;
  1254.  
  1255.  
  1256.   PROCEDURE BLOCKCOMMENT(COLUMN: LINEINDEX;
  1257.                          INITCHAR: CHAR);
  1258.  
  1259.     VAR
  1260.       TERMCHAR1, TERMCHAR2: CHAR;
  1261.       COMSTART: INTEGER;
  1262.  
  1263.     BEGIN
  1264.       PRINTLINE(COLUMN - 1);
  1265.       COMSTART := CHARCOUNT;
  1266.       FIRSTINPUTLINE := TRUE;
  1267.       IF INITCHAR = '{' THEN
  1268.         BEGIN
  1269.           TERMCHAR1 := '}';
  1270.           TERMCHAR2 := '}';
  1271.           PREVCH := '{';
  1272.           BLOCKCOMCHAR('{')
  1273.         END
  1274.       ELSE
  1275.         BEGIN
  1276.           TERMCHAR1 := '*';
  1277.           TERMCHAR2 := ')';
  1278.           PREVCH := '*';
  1279.           BLOCKCOMCHAR('(');
  1280.           BLOCKCOMCHAR('*');
  1281.         END;
  1282.       GETCHAR;
  1283.       IF CH = '$' THEN
  1284.         DOCOMPILERDIRECTIVES(1);
  1285.       IF CH = '[' THEN
  1286.         DOFORMATTERDIRECTIVES(1);
  1287.       REPEAT
  1288.         WHILE CH <> TERMCHAR1 DO
  1289.           BEGIN
  1290.             BLOCKCOMCHAR(CH);
  1291.             GETCHAR;
  1292.           END;
  1293.         IF CH = '*' THEN
  1294.           BEGIN
  1295.             GETCHAR;
  1296.             IF CH <> ')' THEN
  1297.               BLOCKCOMCHAR('*');
  1298.           END;
  1299.       UNTIL CH = TERMCHAR2;
  1300.       IF CH = '}' THEN
  1301.         BLOCKCOMCHAR('}')
  1302.       ELSE
  1303.         BEGIN
  1304.           BLOCKCOMCHAR('*');
  1305.           BLOCKCOMCHAR(')');
  1306.         END;
  1307.       INDIRECTIVES := FALSE;
  1308.       IF BLOCK THEN
  1309.         ADJUSTBLOCKCOMMENT(COMSTART);
  1310.     END;
  1311.  
  1312.  
  1313.   PROCEDURE STATCOMMENT(INITCHAR: CHAR);
  1314.  
  1315.     VAR
  1316.       TERMCHAR1, TERMCHAR2: CHAR;
  1317.  
  1318.     BEGIN
  1319.       STATBREAK := 0;
  1320.       STATBLANKS := FALSE;
  1321.       INDENTPLUS(WRITECOL + COMMENTSPACES + 1 - INDENT);
  1322.       IF INDENT > THREEFOURTHLINE THEN
  1323.         BEGIN
  1324.           UNDENT;
  1325.           INDENTPLUS(TABSPACES);
  1326.         END;
  1327.       IF WRITECOL < OUTLINELEN - COMMENTSPACES - 1 THEN
  1328.         IF INDECLARATION THEN
  1329.           IF (REMARKCOL - WRITECOL) > COMMENTSPACES THEN
  1330.             SPACE(REMARKCOL - WRITECOL)
  1331.           ELSE
  1332.             SPACE(COMMENTSPACES)
  1333.         ELSE
  1334.           SPACE(COMMENTSPACES);
  1335.       IF INITCHAR = '{' THEN
  1336.         BEGIN
  1337.           TERMCHAR1 := '}';
  1338.           TERMCHAR2 := '}';
  1339.           STATCOMCHAR('{')
  1340.         END
  1341.       ELSE
  1342.         BEGIN
  1343.           TERMCHAR1 := '*';
  1344.           TERMCHAR2 := ')';
  1345.           STATCOMCHAR('(');
  1346.           STATCOMCHAR('*');
  1347.         END;
  1348.       GETCHAR;
  1349.       IF CH = '$' THEN
  1350.         DOCOMPILERDIRECTIVES(2);
  1351.       IF CH = '[' THEN
  1352.         DOFORMATTERDIRECTIVES(2);
  1353.       REPEAT
  1354.         WHILE CH <> TERMCHAR1 DO
  1355.           BEGIN
  1356.             STATCOMCHAR(CH);
  1357.             GETCHAR;
  1358.           END;
  1359.         IF CH = '*' THEN
  1360.           BEGIN
  1361.             GETCHAR;
  1362.             IF CH <> ')' THEN
  1363.               STATCOMCHAR('*');
  1364.           END;
  1365.       UNTIL CH = TERMCHAR2;
  1366.       IF CH = '}' THEN
  1367.         STATCOMCHAR('}')
  1368.       ELSE
  1369.         BEGIN
  1370.           STATCOMCHAR('*');
  1371.           STATCOMCHAR(')');
  1372.         END;
  1373.       ADJUSTSTATCOMMENT;
  1374.       UNDENT;
  1375.       BLANKLINES := 0;
  1376.       NEWINPUTLINE := FALSE;
  1377.     END;
  1378.   BEGIN
  1379.     NEWINPUTLINE := FALSE;
  1380.     IF BLOCK THEN
  1381.       BLOCKCOMMENT(INITCOL, INITCHAR)
  1382.     ELSE
  1383.       STATCOMMENT(INITCHAR);
  1384.     FORMATTING := NEWFORMATTING;
  1385.     NEWINPUTLINE := FALSE;
  1386.     GETCHAR;
  1387.     WHILE (CH = ' ') AND NOT NEWINPUTLINE DO
  1388.       GETCHAR;
  1389.     IF FORMATTING AND NEWINPUTLINE THEN
  1390.       ENDLINE := TRUE;
  1391.     SYMBOLFOUND := FALSE;
  1392.     LASTSYM := COMMENT;
  1393.   END;
  1394.  
  1395.  
  1396. PROCEDURE SYMBOLPUT(THISCHAR: CHAR);
  1397.  
  1398.   BEGIN
  1399.     SYMLEN := SYMLEN + 1;
  1400.     SYMBOL[SYMLEN] := THISCHAR;
  1401.     GETCHAR;
  1402.   END;
  1403.  
  1404.  
  1405. PROCEDURE PRINTCHAR;
  1406.  
  1407.   BEGIN
  1408.     IF WRITECOL >= OUTLINELEN THEN
  1409.       PRINTLINE(INDENT + CONTINUESPACES);
  1410.     IF FORMATTING THEN
  1411.       WRITEA(CH);
  1412.     GETCHAR;
  1413.   END;
  1414.  
  1415.  
  1416. PROCEDURE SCANBLANKS;
  1417.  
  1418.   BEGIN
  1419.     WHILE (CH = ' ') AND NOT ENDFILE DO
  1420.       GETCHAR;
  1421.   END;
  1422.  
  1423.  
  1424. PROCEDURE STRINGCONSTANT;
  1425.  
  1426.   VAR
  1427.     STRINGEND: BOOLEAN;
  1428.  
  1429.   BEGIN
  1430.     NEWINPUTLINE := FALSE;
  1431.     SYMBOLFOUND := TRUE;
  1432.     SYM := STRCONST;
  1433.     REPEAT
  1434.       IF CH = '#' THEN
  1435.         BEGIN
  1436.           SYMBOLPUT(CH);
  1437.           IF CH = '$' THEN
  1438.             BEGIN
  1439.               SYMBOLPUT(CH);
  1440.               WHILE CH IN ['0'..'9', 'A'..'F', 'a'..'f'] DO
  1441.                 SYMBOLPUT(UPPERCASE[CH]);
  1442.             END
  1443.           ELSE
  1444.             WHILE CH IN ['0'..'9'] DO
  1445.               SYMBOLPUT(CH);
  1446.         END
  1447.       ELSE IF CH = '^' THEN
  1448.         BEGIN
  1449.           SYMBOLPUT(CH);
  1450.           IF CH IN ['@'..'_', 'a'..'z'] THEN
  1451.             SYMBOLPUT(UPPERCASE[CH]);
  1452.         END
  1453.       ELSE IF CH = '''' THEN
  1454.         BEGIN
  1455.           STRINGEND := FALSE;
  1456.           REPEAT
  1457.             SYMBOLPUT(CH);
  1458.             IF CH = '''' THEN
  1459.               BEGIN
  1460.                 SYMBOLPUT(CH);
  1461.                 STRINGEND := CH <> '''';
  1462.               END;
  1463.           UNTIL NEWINPUTLINE OR STRINGEND;
  1464.         END;
  1465.       STRINGEND := (CH <> '#') AND (CH <> '^') AND (CH <> '''');
  1466.     UNTIL NEWINPUTLINE OR STRINGEND;
  1467.     IF NOT STRINGEND THEN
  1468.       ABORT(SYNTAX);
  1469.   END;
  1470.  
  1471.  
  1472. PROCEDURE TESTRESVWRD;
  1473.  
  1474.   VAR
  1475.     ID: WORDTYPE;
  1476.     INDEX: 1..NORESWORDS;
  1477.     P: 1..MAXWORDLEN;
  1478.  
  1479.   BEGIN
  1480.     IF (SYMLEN >= 2) AND (SYMLEN <= MAXWORDLEN) THEN
  1481.       BEGIN
  1482.         FOR P := 1 TO MAXWORDLEN DO
  1483.           IF P > SYMLEN THEN
  1484.             ID[P] := ' '
  1485.           ELSE
  1486.             ID[P] := LOWERCASE[SYMBOL[P]];
  1487.         WITH RESLEN[SYMLEN] DO
  1488.           BEGIN
  1489.             INDEX := LOWINDEX;
  1490.             WHILE (RESVWRD[INDEX] <> ID) AND (INDEX < HIINDEX) DO
  1491.               INDEX := INDEX + 1;
  1492.           END;
  1493.         IF RESVWRD[INDEX] = ID THEN
  1494.           SYM := RESSYMBOL[INDEX]
  1495.         ELSE
  1496.           SYM := IDENTIFIER;
  1497.       END
  1498.     ELSE
  1499.       SYM := IDENTIFIER;
  1500.   END;
  1501.  
  1502.  
  1503. PROCEDURE SETSYMBOLCASE(KIND: SYMBOLS);
  1504.  
  1505.   VAR
  1506.     LASTUNDERSCORE: BOOLEAN;
  1507.     I, J: LINEINDEX;
  1508.  
  1509.   BEGIN
  1510.     IF KIND = IDENTIFIER THEN
  1511.       BEGIN
  1512.         IF EXPORTMODE THEN
  1513.           BEGIN
  1514.             J := 0;
  1515.             LASTUNDERSCORE := TRUE;
  1516.             FOR I := 1 TO SYMLEN DO
  1517.               IF SYMBOL[I] = '_' THEN
  1518.                 LASTUNDERSCORE := TRUE
  1519.               ELSE IF LASTUNDERSCORE THEN
  1520.                 BEGIN
  1521.                   LASTUNDERSCORE := FALSE;
  1522.                   J := J + 1;
  1523.                   SYMBOL[J] := UPPERCASE[SYMBOL[I]];
  1524.                 END
  1525.               ELSE
  1526.                 BEGIN
  1527.                   J := J + 1;
  1528.                   SYMBOL[J] := LOWERCASE[SYMBOL[I]];
  1529.                 END;
  1530.             FOR I := J + 1 TO SYMLEN DO
  1531.               SYMBOL[I] := ' ';
  1532.             SYMLEN := J;
  1533.           END;
  1534.         IF UCIDENTS THEN
  1535.           FOR I := 1 TO SYMLEN DO
  1536.             SYMBOL[I] := UPPERCASE[SYMBOL[I]]
  1537.         ELSE IF LCIDENTS THEN
  1538.           FOR I := 1 TO SYMLEN DO
  1539.             SYMBOL[I] := LOWERCASE[SYMBOL[I]];
  1540.       END
  1541.     ELSE
  1542.       BEGIN
  1543.         IF UCRESWORDS THEN
  1544.           FOR I := 1 TO SYMLEN DO
  1545.             SYMBOL[I] := UPPERCASE[SYMBOL[I]]
  1546.         ELSE IF LCRESWORDS THEN
  1547.           FOR I := 1 TO SYMLEN DO
  1548.             SYMBOL[I] := LOWERCASE[SYMBOL[I]];
  1549.       END;
  1550.   END;
  1551.  
  1552.  
  1553. PROCEDURE ALPHACHAR;
  1554.  
  1555.   BEGIN
  1556.     NEWINPUTLINE := FALSE;
  1557.     SYMBOLFOUND := TRUE;
  1558.     WHILE CH IN ['A'..'Z', 'a'..'z', '0'..'9', '_'] DO
  1559.       SYMBOLPUT(CH);
  1560.     TESTRESVWRD;
  1561.     SETSYMBOLCASE(SYM);
  1562.   END;
  1563.  
  1564.  
  1565. PROCEDURE NUMERICCHAR;
  1566.  
  1567.   BEGIN
  1568.     NEWINPUTLINE := FALSE;
  1569.     SYMBOLFOUND := TRUE;
  1570.     SYM := NUMBER;
  1571.     IF CH = '$' THEN
  1572.       BEGIN
  1573.         SYMBOLPUT('$');
  1574.         WHILE CH IN ['0'..'9', 'A'..'F', 'a'..'f'] DO
  1575.           SYMBOLPUT(UPPERCASE[CH]);
  1576.       END
  1577.     ELSE
  1578.       BEGIN
  1579.         WHILE (CH >= '0') AND (CH <= '9') DO
  1580.           SYMBOLPUT(CH);
  1581.         IF CH = '.' THEN
  1582.           BEGIN
  1583.             SYMBOLPUT(CH);
  1584.             IF CH = '.' THEN
  1585.               BEGIN
  1586.                 SYMLEN := SYMLEN - 1;
  1587.                 DOUBLEPERIOD := TRUE;
  1588.               END
  1589.             ELSE
  1590.               WHILE (CH >= '0') AND (CH <= '9') DO
  1591.                 SYMBOLPUT(CH);
  1592.           END;
  1593.         IF (CH = 'E') OR (CH = 'e') THEN
  1594.           BEGIN
  1595.             SYMBOLPUT('E');
  1596.             IF (CH = '+') OR (CH = '-') THEN
  1597.               SYMBOLPUT(CH);
  1598.             WHILE (CH >= '0') AND (CH <= '9') DO
  1599.               SYMBOLPUT(CH);
  1600.           END
  1601.       END;
  1602.   END;
  1603.  
  1604.  
  1605. PROCEDURE SPECIALCHAR;
  1606.  
  1607.   BEGIN
  1608.     SYMBOLFOUND := TRUE;
  1609.     NEWINPUTLINE := FALSE;
  1610.     CASE CH OF
  1611.       '+':
  1612.         BEGIN
  1613.           SYM := PLUS;
  1614.           SYMBOLPUT(CH);
  1615.         END;
  1616.       '-':
  1617.         BEGIN
  1618.           SYM := MINUS;
  1619.           SYMBOLPUT(CH);
  1620.         END;
  1621.       '*':
  1622.         BEGIN
  1623.           SYM := MULT;
  1624.           SYMBOLPUT(CH);
  1625.         END;
  1626.       '/':
  1627.         BEGIN
  1628.           SYM := DIVIDE;
  1629.           SYMBOLPUT(CH);
  1630.         END;
  1631.       '.':
  1632.         BEGIN
  1633.           SYM := PERIOD;
  1634.           SYMBOLPUT(CH);
  1635.           IF DOUBLEPERIOD THEN
  1636.             BEGIN
  1637.               SYMBOL[2] := '.';
  1638.               SYMLEN := 2;
  1639.               SYM := SUBRANGE;
  1640.             END
  1641.           ELSE IF CH = '.' THEN
  1642.             BEGIN
  1643.               SYM := SUBRANGE;
  1644.               SYMBOLPUT(CH);
  1645.             END;
  1646.           DOUBLEPERIOD := FALSE;
  1647.         END;
  1648.       ',':
  1649.         BEGIN
  1650.           SYM := COMMA;
  1651.           SYMBOLPUT(CH);
  1652.         END;
  1653.       ';':
  1654.         BEGIN
  1655.           SYM := SEMICOLON;
  1656.           SYMBOLPUT(CH);
  1657.         END;
  1658.       ':':
  1659.         BEGIN
  1660.           SYM := COLON;
  1661.           SYMBOLPUT(CH);
  1662.           IF CH = '=' THEN
  1663.             BEGIN
  1664.               SYM := BECOMES;
  1665.               SYMBOLPUT(CH);
  1666.             END;
  1667.         END;
  1668.       '=':
  1669.         BEGIN
  1670.           SYM := EQUAL;
  1671.           SYMBOLPUT(CH);
  1672.         END;
  1673.       '<':
  1674.         BEGIN
  1675.           SYM := RELOP;
  1676.           SYMBOLPUT(CH);
  1677.           IF (CH = '=') OR (CH = '>') THEN
  1678.             SYMBOLPUT(CH);
  1679.         END;
  1680.       '>':
  1681.         BEGIN
  1682.           SYM := RELOP;
  1683.           SYMBOLPUT(CH);
  1684.           IF CH = '=' THEN
  1685.             SYMBOLPUT(CH);
  1686.         END;
  1687.       '^':
  1688.         BEGIN
  1689.           IF INTYPEORVARDCL OR (LASTSYM IN [IDENTIFIER, CLOSEBRACK]) THEN
  1690.             BEGIN
  1691.               SYM := POINTER;
  1692.               SYMBOLPUT(CH);
  1693.             END
  1694.           ELSE
  1695.             STRINGCONSTANT;
  1696.         END;
  1697.       '''', '#': STRINGCONSTANT;
  1698.       ')':
  1699.         BEGIN
  1700.           SYM := CLOSEPAREN;
  1701.           SYMBOLPUT(CH);
  1702.         END;
  1703.       '[':
  1704.         BEGIN
  1705.           SYM := OPENBRACK;
  1706.           SYMBOLPUT(CH);
  1707.         END;
  1708.       ']':
  1709.         BEGIN
  1710.           SYM := CLOSEBRACK;
  1711.           SYMBOLPUT(CH);
  1712.         END;
  1713.     END;
  1714.   END;
  1715.  
  1716.  
  1717. PROCEDURE COMMENTCHAR;
  1718.  
  1719.   VAR
  1720.     INITCHAR: CHAR;
  1721.  
  1722.   BEGIN
  1723.     IF CH = '(' THEN
  1724.       BEGIN
  1725.         INITCHAR := CH;
  1726.         SYMBOLPUT(CH);
  1727.         IF CH = '*' THEN
  1728.           BEGIN
  1729.             SYMLEN := 0;
  1730.             DOCOMMENT(NEWINPUTLINE, COLUMN - 1, INITCHAR);
  1731.           END
  1732.         ELSE
  1733.           BEGIN
  1734.             SYM := OPENPAREN;
  1735.             NEWINPUTLINE := FALSE;
  1736.             SYMBOLFOUND := TRUE;
  1737.           END;
  1738.       END
  1739.     ELSE
  1740.       DOCOMMENT(NEWINPUTLINE, COLUMN, CH);
  1741.   END;
  1742.  
  1743.  
  1744. PROCEDURE GETSYM;
  1745.  
  1746.   BEGIN
  1747.     SYMLEN := 0;
  1748.     SYMBOLFOUND := FALSE;
  1749.     SYMWRITTEN := FALSE;
  1750.     REPEAT
  1751.       IF ENDFILE THEN
  1752.         BEGIN
  1753.           SYM := TEXTEND;
  1754.           SYMBOLFOUND := TRUE
  1755.         END
  1756.       ELSE IF CH = ' ' THEN
  1757.         SCANBLANKS
  1758.       ELSE
  1759.         BEGIN
  1760.           CASE CH OF
  1761.             '0'..'9', '$': NUMERICCHAR;
  1762.             'A'..'Z', 'a'..'z', '_': ALPHACHAR;
  1763.             ')', '*', '/', '+', ',', '-', '.', ':', ';', '<', '=', '>', '[',
  1764.             ']', '^', '''', '#': SPECIALCHAR;
  1765.             '(', '{': COMMENTCHAR;
  1766.             '!', '&', '?', '\', '`', '|', '~', '}', '"', '@': PRINTCHAR;
  1767.             ELSE
  1768.               IF FORMATTING AND (CH = CHR(FF)) THEN
  1769.                 BEGIN
  1770.                   PRINTLINE(0);
  1771.                   PRINTCHAR;
  1772.                   SPACE(0);
  1773.                   CLEARBREAKS;
  1774.                   ENDLINE := TRUE;
  1775.                 END
  1776.               ELSE
  1777.                 GETCHAR;
  1778.           END
  1779.         END;
  1780.     UNTIL SYMBOLFOUND;
  1781.   END;
  1782.  
  1783.  
  1784. PROCEDURE NEXTSYM;
  1785.  
  1786.   BEGIN
  1787.     IF SYM <> TEXTEND THEN
  1788.       BEGIN
  1789.         IF NOT SYMWRITTEN THEN
  1790.           PUTSYM;
  1791.         GETSYM;
  1792.       END;
  1793.   END;
  1794.  
  1795.  
  1796. PROCEDURE CHECK(FSYM: SETOFSYMS);
  1797.  
  1798.   BEGIN
  1799.     IF NOT (SYM IN FSYM) THEN
  1800.       ABORT(SYNTAX);
  1801.   END;
  1802.  
  1803.  
  1804. PROCEDURE CHECKSYM(DESIRED: SYMBOLS);
  1805.  
  1806.   BEGIN
  1807.     IF SYM = DESIRED THEN
  1808.       NEXTSYM
  1809.     ELSE
  1810.       ABORT(SYNTAX);
  1811.   END;
  1812.  
  1813.  
  1814. PROCEDURE NEXTONNEWLINE(SPACING, DELTA: INTEGER);
  1815.  
  1816.   BEGIN
  1817.     IF (BLANKLINES > 0) OR (CURRENTLINE = 0) THEN
  1818.       SPACING := SPACING - 1;
  1819.     REPEAT
  1820.       FORMATLINE(INDENT);
  1821.       SPACING := SPACING - 1;
  1822.     UNTIL SPACING < 0;
  1823.     INDENTPLUS(DELTA);
  1824.     STATINDENT := INDENT;
  1825.     NEXTSYM;
  1826.   END;
  1827.  
  1828.  
  1829. PROCEDURE LOGSYMBOLSTART(VAR LOG: COLLOG);
  1830.  
  1831.   BEGIN
  1832.     WITH LOG DO
  1833.       BEGIN
  1834.         LOGCHAR := CHARCOUNT + 1;
  1835.         LOGCOL := WRITECOL + 1;
  1836.         LOGLINE := CURRENTLINE;
  1837.       END;
  1838.   END;
  1839.  
  1840.  
  1841. PROCEDURE BUNCH(START: COLLOG;
  1842.                 VAR SUCCESS: BOOLEAN);
  1843.  
  1844.   BEGIN
  1845.     WITH START DO
  1846.       IF FORMATTING AND (CHARCOUNT - LOGCHAR < BUFSIZE) AND
  1847.          (CHARCOUNT >= LOGCHAR) AND (LOGLINE + 1 = CURRENTLINE) AND
  1848.          (WRITECOL - INDENT + LOGCOL < OUTLINELEN) THEN
  1849.         BEGIN
  1850.           WITH UNWRITTEN[LOGCHAR MOD BUFSIZE] DO
  1851.             BEGIN
  1852.               ACTIONIS := SPACES;
  1853.               SPACING := 1;
  1854.               WRITECOL := WRITECOL - INDENT + LOGCOL + 1;
  1855.             END;
  1856.           CURRENTLINE := CURRENTLINE - 1;
  1857.           SUCCESS := TRUE;
  1858.         END
  1859.       ELSE
  1860.         SUCCESS := FALSE;
  1861.   END;
  1862.  
  1863.  
  1864. PROCEDURE BUNCHSTATEMENT(START: COLLOG);
  1865.  
  1866.   VAR
  1867.     TABINT: INTEGER;
  1868.     NEXTTAB: INTEGER;
  1869.  
  1870.   BEGIN
  1871.     IF FORMATTING THEN
  1872.       WITH START DO
  1873.         BEGIN
  1874.           TABINT := (OUTLINELEN - INDENT) DIV STATSPERLINE;
  1875.           IF TABINT = 0 THEN
  1876.             TABINT := 1;
  1877.           IF LOGCOL = INDENT + 1 THEN
  1878.             LOGCOL := INDENT;
  1879.           NEXTTAB := (LOGCOL - INDENT + TABINT - 1) DIV TABINT * TABINT +
  1880.                      INDENT;
  1881.           IF (NEXTTAB > INDENT) AND (LOGLINE + 1 = CURRENTLINE) AND
  1882.              (CHARCOUNT - LOGCHAR < BUFSIZE) AND
  1883.              (NEXTTAB + WRITECOL - INDENT <= OUTLINELEN) THEN
  1884.             BEGIN
  1885.               WITH UNWRITTEN[LOGCHAR MOD BUFSIZE] DO
  1886.                 BEGIN
  1887.                   ACTIONIS := SPACES;
  1888.                   SPACING := NEXTTAB - LOGCOL + 1;
  1889.                 END;
  1890.               WRITECOL := NEXTTAB + WRITECOL - INDENT;
  1891.               CURRENTLINE := CURRENTLINE - 1;
  1892.             END;
  1893.         END;
  1894.   END;
  1895.  
  1896.  
  1897. PROCEDURE TERMINALSEMICOLON;
  1898.  
  1899.   BEGIN
  1900.     IF (SYM = SEMICOLON) AND NOT SYMWRITTEN THEN
  1901.       PUTSYM;
  1902.   END;
  1903.  
  1904.  
  1905. PROCEDURE STATEMENT;
  1906.   FORWARD;
  1907.  
  1908.  
  1909. PROCEDURE EXPRESSION;
  1910.   FORWARD;
  1911.  
  1912.  
  1913. PROCEDURE EXPRLIST(BREAKAT: INTEGER);
  1914.   FORWARD;
  1915.  
  1916.  
  1917. PROCEDURE SCANTYPE;
  1918.   FORWARD;
  1919.  
  1920.  
  1921. PROCEDURE DOBLOCK;
  1922.   FORWARD;
  1923.  
  1924.  
  1925. PROCEDURE IDENTLIST;
  1926.  
  1927.   BEGIN
  1928.     WHILE SYM = IDENTIFIER DO
  1929.       BEGIN
  1930.         NEXTSYM;
  1931.         IF SYM = COMMA THEN
  1932.           BEGIN
  1933.             NEXTSYM;
  1934.             SETSYMBOLBREAK(0);
  1935.           END;
  1936.       END;
  1937.   END;
  1938.  
  1939.  
  1940. PROCEDURE CONSTANT;
  1941.  
  1942.   BEGIN
  1943.     IF SYM IN [PLUS, MINUS] THEN
  1944.       NEXTSYM;
  1945.     CHECK(CONSTANTS - [PLUS, MINUS]);
  1946.     NEXTSYM;
  1947.   END;
  1948.  
  1949.  
  1950. PROCEDURE VARIABLE;
  1951.  
  1952.   BEGIN
  1953.     WHILE SYM IN [IDENTIFIER, PERIOD, POINTER, OPENBRACK] DO
  1954.       BEGIN
  1955.         IF SYM = OPENBRACK THEN
  1956.           BEGIN
  1957.             NEXTSYM;
  1958.             EXPRLIST(0);
  1959.             CHECKSYM(CLOSEBRACK);
  1960.           END
  1961.         ELSE
  1962.           NEXTSYM;
  1963.       END;
  1964.   END;
  1965.  
  1966.  
  1967. PROCEDURE CONSTLIST;
  1968.  
  1969.   BEGIN
  1970.     WHILE SYM IN CONSTANTS DO
  1971.       BEGIN
  1972.         CONSTANT;
  1973.         IF SYM = SUBRANGE THEN
  1974.           BEGIN
  1975.             NEXTSYM;
  1976.             CONSTANT;
  1977.           END;
  1978.         IF SYM = COMMA THEN
  1979.           BEGIN
  1980.             NEXTSYM;
  1981.             SETSYMBOLBREAK(0);
  1982.           END;
  1983.       END;
  1984.   END;
  1985.  
  1986.  
  1987. PROCEDURE FACTOR;
  1988.  
  1989.   BEGIN
  1990.     IF SYM = OPENPAREN THEN
  1991.       BEGIN
  1992.         NEXTSYM;
  1993.         EXPRLIST(0);
  1994.         CHECKSYM(CLOSEPAREN);
  1995.         IF SYM = COMMA THEN
  1996.           SETSYMBOLBREAK(3);
  1997.       END
  1998.     ELSE IF SYM = OPENBRACK THEN
  1999.       BEGIN
  2000.         NEXTSYM;
  2001.         WHILE SYM IN EXPRBEGSYS DO
  2002.           BEGIN
  2003.             EXPRLIST(1);
  2004.             IF SYM = SUBRANGE THEN
  2005.               NEXTSYM;
  2006.           END;
  2007.         CHECKSYM(CLOSEBRACK);
  2008.       END
  2009.     ELSE IF SYM = IDENTIFIER THEN
  2010.       BEGIN
  2011.         VARIABLE;
  2012.         IF SYM = OPENPAREN THEN
  2013.           BEGIN
  2014.             PUTSYM;
  2015.             IF WRITECOL <= THREEFOURTHLINE THEN
  2016.               INDENTPLUS(WRITECOL - INDENT)
  2017.             ELSE
  2018.               INDENTPLUS(0);
  2019.             NEXTSYM;
  2020.             EXPRLIST(3);
  2021.             CHECKSYM(CLOSEPAREN);
  2022.             UNDENT;
  2023.           END
  2024.       END
  2025.     ELSE
  2026.       CONSTANT;
  2027.   END;
  2028.  
  2029.  
  2030. PROCEDURE EXPRESSION;
  2031.  
  2032.   BEGIN
  2033.     WHILE SYM IN EXPRBEGSYS DO
  2034.       BEGIN
  2035.         IF SYM IN [PLUS, MINUS, NOTSYM, POINTER] THEN
  2036.           NEXTSYM;
  2037.         FACTOR;
  2038.         IF SYM IN [ANDSYM, ORSYM, SHLSYM, SHRSYM, XORSYM] THEN
  2039.           BEGIN
  2040.             NEXTSYM;
  2041.             SETSYMBOLBREAK(3);
  2042.           END
  2043.         ELSE IF SYM IN RELOPS THEN
  2044.           BEGIN
  2045.             NEXTSYM;
  2046.             SETSYMBOLBREAK(2);
  2047.           END
  2048.         ELSE IF SYM IN ARITHOPS THEN
  2049.           BEGIN
  2050.             NEXTSYM;
  2051.             SETSYMBOLBREAK(1);
  2052.           END;
  2053.       END;
  2054.   END;
  2055.  
  2056.  
  2057. PROCEDURE EXPRLIST;
  2058.  
  2059.   BEGIN
  2060.     WHILE SYM IN EXPRBEGSYS + [COMMA] DO
  2061.       BEGIN
  2062.         IF SYM IN EXPRBEGSYS THEN
  2063.           EXPRESSION;
  2064.         IF (SYM = COMMA) OR (SYM = COLON) THEN
  2065.           BEGIN
  2066.             NEXTSYM;
  2067.             SETSYMBOLBREAK(BREAKAT);
  2068.           END;
  2069.       END;
  2070.   END;
  2071.  
  2072.  
  2073. PROCEDURE STATLIST;
  2074.  
  2075.   VAR
  2076.     STATTERMS: SETOFSYMS;
  2077.     STATSTART: COLLOG;
  2078.     FIRSTSTAT: BOOLEAN;
  2079.  
  2080.   BEGIN
  2081.     STATTERMS := STATSET + [SEMICOLON];
  2082.     FIRSTSTAT := TRUE;
  2083.     REPEAT
  2084.       LOGSYMBOLSTART(STATSTART);
  2085.       STATEMENT;
  2086.       TERMINALSEMICOLON;
  2087.       IF (STATSPERLINE > 1) AND NOT FIRSTSTAT THEN
  2088.         BUNCHSTATEMENT(STATSTART);
  2089.       IF SYM = SEMICOLON THEN
  2090.         GETSYM;
  2091.       FIRSTSTAT := FALSE;
  2092.     UNTIL NOT (SYM IN STATTERMS);
  2093.   END;
  2094.  
  2095.  
  2096. PROCEDURE DOBEGIN(PROCBLOCK: BOOLEAN);
  2097.  
  2098.   VAR
  2099.     TRIM: INTEGER;
  2100.  
  2101.   BEGIN
  2102.     RESETCHARCOUNT;
  2103.     IF PROCBLOCK THEN
  2104.       TRIM := TABSPACES
  2105.     ELSE
  2106.       TRIM := 0;
  2107.     NEXTONNEWLINE(0, TRIM);
  2108.     STATLIST;
  2109.     UNDENT;
  2110.     FORMATLINE(INDENT);
  2111.     CHECKSYM(ENDSYM);
  2112.   END;
  2113.  
  2114.  
  2115. PROCEDURE DOASSIGNCALL;
  2116.  
  2117.   BEGIN
  2118.     FORMATLINE(INDENT);
  2119.     INDENTPLUS(CONTINUESPACES);
  2120.     NEXTSYM;
  2121.     IF SYM = COLON THEN
  2122.       BEGIN
  2123.         NEXTSYM;
  2124.         STATEMENT;
  2125.       END
  2126.     ELSE
  2127.       BEGIN
  2128.         VARIABLE;
  2129.         IF SYM = BECOMES THEN
  2130.           BEGIN
  2131.             NEXTSYM;
  2132.             IF WRITECOL < THREEFOURTHLINE THEN
  2133.               INDENTPLUS(WRITECOL - INDENT + 1)
  2134.             ELSE
  2135.               BEGIN
  2136.                 INDENTPLUS(0);
  2137.                 SETSYMBOLBREAK(0);
  2138.               END;
  2139.             EXPRESSION;
  2140.             TERMINALSEMICOLON;
  2141.             UNDENT;
  2142.           END
  2143.         ELSE IF SYM = OPENPAREN THEN
  2144.           BEGIN
  2145.             NEXTSYM;
  2146.             IF WRITECOL <= THREEFOURTHLINE THEN
  2147.               INDENTPLUS(WRITECOL - INDENT)
  2148.             ELSE
  2149.               INDENTPLUS(0);
  2150.             EXPRLIST(3);
  2151.             CHECKSYM(CLOSEPAREN);
  2152.             TERMINALSEMICOLON;
  2153.             UNDENT;
  2154.           END
  2155.         ELSE
  2156.           TERMINALSEMICOLON;
  2157.         UNDENT;
  2158.       END;
  2159.   END;
  2160.  
  2161.  
  2162. PROCEDURE DOGOTO;
  2163.  
  2164.   BEGIN
  2165.     FORMATLINE(INDENT);
  2166.     NEXTSYM;
  2167.     IF SYM IN [NUMBER, IDENTIFIER] THEN
  2168.       NEXTSYM
  2169.     ELSE
  2170.       ABORT(SYNTAX);
  2171.     TERMINALSEMICOLON;
  2172.   END;
  2173.  
  2174.  
  2175. PROCEDURE DOINLINE;
  2176.  
  2177.   BEGIN
  2178.     FORMATLINE(INDENT);
  2179.     INDENTPLUS(CONTINUESPACES);
  2180.     NEXTSYM;
  2181.     IF SYM <> OPENPAREN THEN
  2182.       ABORT(SYNTAX);
  2183.     REPEAT
  2184.       NEXTSYM;
  2185.       IF SYM = MULT THEN
  2186.         BEGIN
  2187.           NEXTSYM;
  2188.           IF SYM IN CONSTANTS THEN
  2189.             CONSTANT;
  2190.         END
  2191.       ELSE
  2192.         CONSTANT;
  2193.     UNTIL SYM <> DIVIDE;
  2194.     CHECKSYM(CLOSEPAREN);
  2195.     TERMINALSEMICOLON;
  2196.     UNDENT;
  2197.   END;
  2198.  
  2199.  
  2200. PROCEDURE DOWHILE;
  2201.  
  2202.   VAR
  2203.     WHILESTART: COLLOG;
  2204.     STARTLINE, ENDLINE: INTEGER;
  2205.     SUCCESSFUL: BOOLEAN;
  2206.  
  2207.   BEGIN
  2208.     RESETCHARCOUNT;
  2209.     FORMATLINE(INDENT);
  2210.     NEXTSYM;
  2211.     IF WRITECOL < THREEFOURTHLINE THEN
  2212.       INDENTPLUS(WRITECOL - INDENT + 1)
  2213.     ELSE
  2214.       INDENTPLUS(CONTINUESPACES);
  2215.     STARTLINE := CURRENTLINE;
  2216.     EXPRESSION;
  2217.     CHECKSYM(DOSYM);
  2218.     UNDENT;
  2219.     INDENTPLUS(TABSPACES);
  2220.     ENDLINE := CURRENTLINE;
  2221.     LOGSYMBOLSTART(WHILESTART);
  2222.     STATINDENT := INDENT;
  2223.     STATEMENT;
  2224.     IF BUNCHING AND (STARTLINE = ENDLINE) THEN
  2225.       BUNCH(WHILESTART, SUCCESSFUL);
  2226.     UNDENT;
  2227.   END;
  2228.  
  2229.  
  2230. PROCEDURE DOWITH;
  2231.  
  2232.   VAR
  2233.     STARTLINE, ENDLINE: INTEGER;
  2234.     WITHSTART: COLLOG;
  2235.     SUCCESSFUL: BOOLEAN;
  2236.  
  2237.   BEGIN
  2238.     RESETCHARCOUNT;
  2239.     FORMATLINE(INDENT);
  2240.     NEXTSYM;
  2241.     IF WRITECOL < THREEFOURTHLINE THEN
  2242.       INDENTPLUS(WRITECOL - INDENT + 1)
  2243.     ELSE
  2244.       INDENTPLUS(CONTINUESPACES);
  2245.     STARTLINE := CURRENTLINE;
  2246.     EXPRLIST(3);
  2247.     CHECKSYM(DOSYM);
  2248.     UNDENT;
  2249.     INDENTPLUS(TABSPACES);
  2250.     STATINDENT := INDENT;
  2251.     ENDLINE := CURRENTLINE;
  2252.     LOGSYMBOLSTART(WITHSTART);
  2253.     STATEMENT;
  2254.     IF BUNCHING AND (STARTLINE = ENDLINE) THEN
  2255.       BUNCH(WITHSTART, SUCCESSFUL);
  2256.     UNDENT;
  2257.   END;
  2258.  
  2259.  
  2260. PROCEDURE DOIF(PREVELSE: BOOLEAN);
  2261.  
  2262.   VAR
  2263.     IFSTART: COLLOG;
  2264.     STARTLINE, ENDLINE: INTEGER;
  2265.     SUCCESSFUL: BOOLEAN;
  2266.  
  2267.   BEGIN
  2268.     RESETCHARCOUNT;
  2269.     IF NOT PREVELSE THEN
  2270.       FORMATLINE(INDENT);
  2271.     NEXTSYM;
  2272.     IF WRITECOL < THREEFOURTHLINE THEN
  2273.       INDENTPLUS(WRITECOL - INDENT + 1)
  2274.     ELSE
  2275.       INDENTPLUS(CONTINUESPACES);
  2276.     STARTLINE := CURRENTLINE;
  2277.     EXPRESSION;
  2278.     CHECKSYM(THENSYM);
  2279.     UNDENT;
  2280.     INDENTPLUS(TABSPACES);
  2281.     ENDLINE := CURRENTLINE;
  2282.     LOGSYMBOLSTART(IFSTART);
  2283.     STATEMENT;
  2284.     IF BUNCHING AND (STARTLINE = ENDLINE) THEN
  2285.       BUNCH(IFSTART, SUCCESSFUL);
  2286.     UNDENT;
  2287.     STATINDENT := INDENT;
  2288.     IF SYM = ELSESYM THEN
  2289.       BEGIN
  2290.         FORMATLINE(INDENT);
  2291.         NEXTSYM;
  2292.         IF SYM = IFSYM THEN
  2293.           DOIF(TRUE)
  2294.         ELSE
  2295.           BEGIN
  2296.             INDENTPLUS(TABSPACES);
  2297.             LOGSYMBOLSTART(IFSTART);
  2298.             STATEMENT;
  2299.             IF BUNCHING THEN
  2300.               BUNCH(IFSTART, SUCCESSFUL);
  2301.             UNDENT;
  2302.           END;
  2303.       END;
  2304.   END;
  2305.  
  2306.  
  2307. PROCEDURE DOCASE;
  2308.  
  2309.   VAR
  2310.     CASESTART: COLLOG;
  2311.     SUCCESSFUL: BOOLEAN;
  2312.     LABSTART, LABEND: INTEGER;
  2313.  
  2314.   BEGIN
  2315.     RESETCHARCOUNT;
  2316.     FORMATLINE(INDENT);
  2317.     NEXTSYM;
  2318.     IF WRITECOL < THREEFOURTHLINE THEN
  2319.       INDENTPLUS(WRITECOL - INDENT + 1)
  2320.     ELSE
  2321.       INDENTPLUS(CONTINUESPACES);
  2322.     EXPRESSION;
  2323.     CHECKSYM(OFSYM);
  2324.     UNDENT;
  2325.     INDENTPLUS(TABSPACES);
  2326.     STATINDENT := INDENT;
  2327.     WHILE NOT (SYM IN [ENDSYM, ELSESYM]) DO
  2328.       BEGIN
  2329.         IF SYM IN CONSTANTS THEN
  2330.           BEGIN
  2331.             FORMATLINE(INDENT);
  2332.             LABSTART := CURRENTLINE;
  2333.             CONSTLIST;
  2334.             CHECKSYM(COLON);
  2335.             LABEND := CURRENTLINE;
  2336.             INDENTPLUS(TABSPACES);
  2337.             LOGSYMBOLSTART(CASESTART);
  2338.             STATEMENT;
  2339.             BUNCH(CASESTART, SUCCESSFUL);
  2340.             UNDENT;
  2341.             STATINDENT := INDENT;
  2342.           END;
  2343.         IF SYM = SEMICOLON THEN
  2344.           NEXTSYM;
  2345.         CHECK(CONSTANTS + [ENDSYM, SEMICOLON, ELSESYM]);
  2346.       END;
  2347.     IF SYM = ELSESYM THEN
  2348.       BEGIN
  2349.         NEXTONNEWLINE(0, TABSPACES);
  2350.         LOGSYMBOLSTART(CASESTART);
  2351.         STATLIST;
  2352.         BUNCH(CASESTART, SUCCESSFUL);
  2353.         UNDENT;
  2354.       END;
  2355.     UNDENT;
  2356.     FORMATLINE(INDENT);
  2357.     CHECKSYM(ENDSYM);
  2358.   END;
  2359.  
  2360.  
  2361. PROCEDURE DOREPEAT;
  2362.  
  2363.   BEGIN
  2364.     RESETCHARCOUNT;
  2365.     NEXTONNEWLINE(0, TABSPACES);
  2366.     STATLIST;
  2367.     UNDENT;
  2368.     STATINDENT := INDENT;
  2369.     FORMATLINE(INDENT);
  2370.     CHECKSYM(UNTILSYM);
  2371.     IF WRITECOL < THREEFOURTHLINE THEN
  2372.       INDENTPLUS(WRITECOL - INDENT + 1)
  2373.     ELSE
  2374.       INDENTPLUS(CONTINUESPACES);
  2375.     EXPRESSION;
  2376.     TERMINALSEMICOLON;
  2377.     UNDENT;
  2378.   END;
  2379.  
  2380.  
  2381. PROCEDURE DOFOR;
  2382.  
  2383.   VAR
  2384.     STARTLINE, ENDLINE: INTEGER;
  2385.     FORSTART: COLLOG;
  2386.     SUCCESSFUL: BOOLEAN;
  2387.  
  2388.   BEGIN
  2389.     RESETCHARCOUNT;
  2390.     NEXTONNEWLINE(0, CONTINUESPACES);
  2391.     STARTLINE := CURRENTLINE;
  2392.     CHECKSYM(IDENTIFIER);
  2393.     CHECKSYM(BECOMES);
  2394.     EXPRESSION;
  2395.     CHECK([TOSYM, DOWNTOSYM]);
  2396.     NEXTSYM;
  2397.     EXPRESSION;
  2398.     CHECKSYM(DOSYM);
  2399.     UNDENT;
  2400.     INDENTPLUS(TABSPACES);
  2401.     ENDLINE := CURRENTLINE;
  2402.     LOGSYMBOLSTART(FORSTART);
  2403.     STATEMENT;
  2404.     IF BUNCHING AND (STARTLINE = ENDLINE) THEN
  2405.       BUNCH(FORSTART, SUCCESSFUL);
  2406.     UNDENT;
  2407.   END;
  2408.  
  2409.  
  2410. PROCEDURE STATEMENT;
  2411.  
  2412.   BEGIN
  2413.     STATINDENT := INDENT;
  2414.     IF SYM = NUMBER THEN
  2415.       BEGIN
  2416.         INDENTPLUS( - TABSPACES);
  2417.         FORMATLINE(INDENT);
  2418.         NEXTSYM;
  2419.         CHECKSYM(COLON);
  2420.         UNDENT;
  2421.       END;
  2422.     IF SYM IN (STATSET - [NUMBER]) THEN
  2423.       CASE SYM OF
  2424.         BEGINSYM: DOBEGIN(TRUE);
  2425.         CASESYM: DOCASE;
  2426.         FORSYM: DOFOR;
  2427.         GOTOSYM: DOGOTO;
  2428.         IDENTIFIER: DOASSIGNCALL;
  2429.         IFSYM: DOIF(FALSE);
  2430.         INLINESYM: DOINLINE;
  2431.         REPEATSYM: DOREPEAT;
  2432.         WHILESYM: DOWHILE;
  2433.         WITHSYM: DOWITH;
  2434.       END;
  2435.     STATINDENT := INDENT;
  2436.   END;
  2437.  
  2438.  
  2439. PROCEDURE PARAMETERS;
  2440.  
  2441.   BEGIN
  2442.     IF WRITECOL > ONEHALFLINE THEN
  2443.       FORMATLINE(INDENT + 2 * TABSPACES);
  2444.     NEXTSYM;
  2445.     INDENTPLUS(WRITECOL - INDENT);
  2446.     WHILE SYM IN [IDENTIFIER, VARSYM] DO
  2447.       BEGIN
  2448.         IF SYM <> IDENTIFIER THEN
  2449.           NEXTSYM;
  2450.         IF SYM <> IDENTIFIER THEN
  2451.           ABORT(SYNTAX);
  2452.         INDENTPLUS(CONTINUESPACES);
  2453.         IDENTLIST;
  2454.         UNDENT;
  2455.         IF SYM = COLON THEN
  2456.           BEGIN
  2457.             NEXTSYM;
  2458.             SCANTYPE;
  2459.           END;
  2460.         IF SYM = SEMICOLON THEN
  2461.           BEGIN
  2462.             NEXTSYM;
  2463.             FORMATLINE(INDENT);
  2464.           END;
  2465.       END;
  2466.     CHECKSYM(CLOSEPAREN);
  2467.     TERMINALSEMICOLON;
  2468.     UNDENT;
  2469.     STATINDENT := INDENT;
  2470.   END;
  2471.  
  2472.  
  2473. PROCEDURE FIELDLIST;
  2474.  
  2475.   VAR
  2476.     INVARPART: BOOLEAN;
  2477.     LABELSTART, LABELEND: INTEGER;
  2478.     CASESTART: COLLOG;
  2479.     SUCCESSFUL: BOOLEAN;
  2480.  
  2481.   BEGIN
  2482.     INVARPART := FALSE;
  2483.     WHILE SYM = IDENTIFIER DO
  2484.       BEGIN
  2485.         INVARPART := TRUE;
  2486.         INDENTPLUS(CONTINUESPACES);
  2487.         IDENTLIST;
  2488.         CHECKSYM(COLON);
  2489.         UNDENT;
  2490.         SCANTYPE;
  2491.         IF SYM = SEMICOLON THEN
  2492.           NEXTSYM;
  2493.         IF SYM = IDENTIFIER THEN
  2494.           FORMATLINE(INDENT);
  2495.       END;
  2496.     IF SYM = CASESYM THEN
  2497.       BEGIN
  2498.         IF INVARPART THEN
  2499.           FORMATLINE(INDENT);
  2500.         NEXTSYM;
  2501.         INDENTPLUS(CONTINUESPACES);
  2502.         IF SYM = IDENTIFIER THEN
  2503.           NEXTSYM
  2504.         ELSE
  2505.           SCANTYPE;
  2506.         IF SYM = COLON THEN
  2507.           BEGIN
  2508.             NEXTSYM;
  2509.             SCANTYPE
  2510.           END;
  2511.         CHECKSYM(OFSYM);
  2512.         UNDENT;
  2513.         INDENTPLUS(TABSPACES);
  2514.         STATINDENT := INDENT;
  2515.         FORMATLINE(INDENT);
  2516.         REPEAT
  2517.           LABELSTART := CURRENTLINE;
  2518.           CONSTLIST;
  2519.           CHECKSYM(COLON);
  2520.           LABELEND := CURRENTLINE;
  2521.           INDENTPLUS(TABSPACES);
  2522.           STATINDENT := INDENT;
  2523.           LOGSYMBOLSTART(CASESTART);
  2524.           FORMATLINE(INDENT);
  2525.           CHECKSYM(OPENPAREN);
  2526.           INDENTPLUS(1);
  2527.           FIELDLIST;
  2528.           UNDENT;
  2529.           CHECKSYM(CLOSEPAREN);
  2530.           UNDENT;
  2531.           STATINDENT := INDENT;
  2532.           IF SYM = SEMICOLON THEN
  2533.             NEXTSYM;
  2534.           IF BUNCHING AND (LABELSTART = LABELEND) THEN
  2535.             BUNCH(CASESTART, SUCCESSFUL);
  2536.           IF NOT (SYM IN [ENDSYM, CLOSEPAREN]) THEN
  2537.             FORMATLINE(INDENT);
  2538.         UNTIL NOT (SYM IN CONSTANTS);
  2539.         UNDENT;
  2540.         STATINDENT := INDENT;
  2541.       END
  2542.   END;
  2543.  
  2544.  
  2545. PROCEDURE RECORDTYPE(PACKEDSTART: COLLOG);
  2546.  
  2547.   BEGIN
  2548.     INDENTPLUS(TABSPACES);
  2549.     WITH PACKEDSTART DO
  2550.       IF FORMATTING AND (LOGCHAR <> 0) AND
  2551.          (CHARCOUNT - LOGCHAR < BUFSIZE) THEN
  2552.         WITH UNWRITTEN[LOGCHAR MOD BUFSIZE] DO
  2553.           BEGIN
  2554.             ACTIONIS := BEGINLINE;
  2555.             SPACING := INDENT;
  2556.             WRITECOL := INDENT + WRITECOL - LOGCOL;
  2557.             CURRENTLINE := CURRENTLINE + 1;
  2558.           END
  2559.       ELSE
  2560.         FORMATLINE(INDENT);
  2561.     NEXTSYM;
  2562.     INDENTPLUS(TABSPACES);
  2563.     STATINDENT := INDENT;
  2564.     FORMATLINE(INDENT);
  2565.     FIELDLIST;
  2566.     UNDENT;
  2567.     FORMATLINE(INDENT);
  2568.     CHECKSYM(ENDSYM);
  2569.     TERMINALSEMICOLON;
  2570.     UNDENT;
  2571.   END;
  2572.  
  2573.  
  2574. PROCEDURE ARRAYTYPE;
  2575.  
  2576.   BEGIN
  2577.     INDENTPLUS(TABSPACES);
  2578.     NEXTSYM;
  2579.     SETSYMBOLBREAK(0);
  2580.     CHECKSYM(OPENBRACK);
  2581.     WHILE SYM IN CONSTANTS DO
  2582.       BEGIN
  2583.         CONSTANT;
  2584.         IF SYM = SUBRANGE THEN
  2585.           BEGIN
  2586.             NEXTSYM;
  2587.             CONSTANT;
  2588.           END;
  2589.         IF (SYM = COMMA) OR (SYM = SEMICOLON) THEN
  2590.           BEGIN
  2591.             NEXTSYM;
  2592.             SETSYMBOLBREAK(0);
  2593.           END;
  2594.       END;
  2595.     CHECKSYM(CLOSEBRACK);
  2596.     CHECKSYM(OFSYM);
  2597.     SCANTYPE;
  2598.     TERMINALSEMICOLON;
  2599.     UNDENT;
  2600.   END;
  2601.  
  2602.  
  2603. PROCEDURE STRING_TYPE;
  2604.  
  2605.   BEGIN
  2606.     NEXTSYM;
  2607.     IF ((SYM <> SEMICOLON) AND (SYM <> CLOSEPAREN)) THEN
  2608.       BEGIN
  2609.         SETSYMBOLBREAK(0);
  2610.         CHECKSYM(OPENBRACK);
  2611.         CONSTANT;
  2612.         CHECKSYM(CLOSEBRACK);
  2613.       END;
  2614.   END;
  2615.  
  2616.  
  2617. PROCEDURE ENUMTYPE;
  2618.  
  2619.   BEGIN
  2620.     NEXTSYM;
  2621.     IF WRITECOL <= THREEFOURTHLINE THEN
  2622.       INDENTPLUS(WRITECOL - INDENT)
  2623.     ELSE
  2624.       INDENTPLUS(CONTINUESPACES);
  2625.     IDENTLIST;
  2626.     CHECKSYM(CLOSEPAREN);
  2627.     TERMINALSEMICOLON;
  2628.     UNDENT;
  2629.   END;
  2630.  
  2631.  
  2632. PROCEDURE SCANTYPE;
  2633.  
  2634.   VAR
  2635.     PACKEDSTART: COLLOG;
  2636.  
  2637.   BEGIN
  2638.     INDENTPLUS(CONTINUESPACES);
  2639.     IF SYM = PACKEDSYM THEN
  2640.       BEGIN
  2641.         LOGSYMBOLSTART(PACKEDSTART);
  2642.         NEXTSYM;
  2643.       END
  2644.     ELSE
  2645.       PACKEDSTART.LOGCHAR := 0;
  2646.     UNDENT;
  2647.     CHECK(TYPEBEGSYS);
  2648.     CASE SYM OF
  2649.       OPENPAREN: ENUMTYPE;
  2650.       ARRAYSYM: ARRAYTYPE;
  2651.       STRINGSYM: STRING_TYPE;
  2652.       FILESYM:
  2653.         BEGIN
  2654.           NEXTSYM;
  2655.           IF SYM = OFSYM THEN
  2656.             BEGIN
  2657.               NEXTSYM;
  2658.               SCANTYPE;
  2659.             END;
  2660.         END;
  2661.       SETSYM:
  2662.         BEGIN
  2663.           NEXTSYM;
  2664.           CHECKSYM(OFSYM);
  2665.           SCANTYPE;
  2666.         END;
  2667.       IDENTIFIER, NUMBER, PLUS, MINUS, STRCONST:
  2668.         BEGIN
  2669.           CONSTANT;
  2670.           IF SYM = SUBRANGE THEN
  2671.             BEGIN
  2672.               NEXTSYM;
  2673.               CONSTANT;
  2674.             END;
  2675.         END;
  2676.       POINTER:
  2677.         BEGIN
  2678.           NEXTSYM;
  2679.           SCANTYPE;
  2680.         END;
  2681.       RECORDSYM: RECORDTYPE(PACKEDSTART);
  2682.     END;
  2683.     STATINDENT := INDENT;
  2684.   END;
  2685.  
  2686.  
  2687. PROCEDURE DOLABEL;
  2688.  
  2689.   BEGIN
  2690.     RESETCHARCOUNT;
  2691.     NEXTONNEWLINE(1, TABSPACES);
  2692.     FORMATLINE(INDENT);
  2693.     WHILE SYM IN [NUMBER, IDENTIFIER] DO
  2694.       BEGIN
  2695.         NEXTSYM;
  2696.         IF SYM = COMMA THEN
  2697.           NEXTSYM;
  2698.       END;
  2699.     CHECKSYM(SEMICOLON);
  2700.     UNDENT;
  2701.   END;
  2702.  
  2703.  
  2704. PROCEDURE STRUCTUREDCONSTANT;
  2705.  
  2706.  
  2707.   PROCEDURE ARRAYORRECORDCONSTANT(BREAKAT: INTEGER);
  2708.  
  2709.     BEGIN
  2710.       REPEAT
  2711.         NEXTSYM;
  2712.         IF SYM = IDENTIFIER THEN
  2713.           BEGIN
  2714.             NEXTSYM;
  2715.             IF SYM = COLON THEN
  2716.               BEGIN
  2717.                 NEXTSYM;
  2718.                 IF SYM = OPENPAREN THEN
  2719.                   ARRAYORRECORDCONSTANT(BREAKAT + 1)
  2720.                 ELSE
  2721.                   CONSTANT;
  2722.               END;
  2723.           END
  2724.         ELSE IF SYM = OPENPAREN THEN
  2725.           ARRAYORRECORDCONSTANT(BREAKAT + 1)
  2726.         ELSE
  2727.           CONSTANT;
  2728.       UNTIL NOT ((SYM = COMMA) OR (SYM = SEMICOLON));
  2729.       CHECKSYM(CLOSEPAREN);
  2730.     END;
  2731.   BEGIN
  2732.     IF SYM = OPENPAREN THEN
  2733.       ARRAYORRECORDCONSTANT(0)
  2734.     ELSE IF SYM = OPENBRACK THEN
  2735.       BEGIN
  2736.         REPEAT
  2737.           NEXTSYM;
  2738.           CONSTANT;
  2739.           IF SYM = SUBRANGE THEN
  2740.             BEGIN
  2741.               NEXTSYM;
  2742.               CONSTANT;
  2743.             END;
  2744.         UNTIL SYM <> COMMA;
  2745.         CHECKSYM(CLOSEBRACK);
  2746.       END
  2747.     ELSE
  2748.       CONSTANT;
  2749.   END;
  2750.  
  2751.  
  2752. PROCEDURE DOCONST;
  2753.  
  2754.   VAR
  2755.     CONSTSTART: COLLOG;
  2756.     FIRSTCONST: BOOLEAN;
  2757.  
  2758.   BEGIN
  2759.     INDECLARATION := TRUE;
  2760.     RESETCHARCOUNT;
  2761.     NEXTONNEWLINE(1, TABSPACES);
  2762.     FIRSTCONST := TRUE;
  2763.     WHILE SYM = IDENTIFIER DO
  2764.       BEGIN
  2765.         LOGSYMBOLSTART(CONSTSTART);
  2766.         FORMATLINE(INDENT);
  2767.         NEXTSYM;
  2768.         IF SYM = COLON THEN
  2769.           BEGIN
  2770.             NEXTSYM;
  2771.             SCANTYPE;
  2772.           END;
  2773.         CHECKSYM(EQUAL);
  2774.         STRUCTUREDCONSTANT;
  2775.         IF SYM = SEMICOLON THEN
  2776.           PUTSYM
  2777.         ELSE
  2778.           ABORT(SYNTAX);
  2779.         IF (STATSPERLINE > 1) AND NOT FIRSTCONST THEN
  2780.           BUNCHSTATEMENT(CONSTSTART);
  2781.         NEXTSYM;
  2782.         FIRSTCONST := FALSE;
  2783.       END;
  2784.     UNDENT;
  2785.     STATINDENT := INDENT;
  2786.     INDECLARATION := FALSE;
  2787.   END;
  2788.  
  2789.  
  2790. PROCEDURE DOTYPE;
  2791.  
  2792.   BEGIN
  2793.     INTYPEORVARDCL := TRUE;
  2794.     INDECLARATION := TRUE;
  2795.     NEXTONNEWLINE(1, TABSPACES);
  2796.     WHILE SYM = IDENTIFIER DO
  2797.       BEGIN
  2798.         RESETCHARCOUNT;
  2799.         FORMATLINE(INDENT);
  2800.         NEXTSYM;
  2801.         CHECKSYM(EQUAL);
  2802.         SCANTYPE;
  2803.         CHECKSYM(SEMICOLON);
  2804.       END;
  2805.     UNDENT;
  2806.     STATINDENT := INDENT;
  2807.     INTYPEORVARDCL := FALSE;
  2808.     INDECLARATION := FALSE;
  2809.   END;
  2810.  
  2811.  
  2812. PROCEDURE DOVAR;
  2813.  
  2814.   BEGIN
  2815.     INTYPEORVARDCL := TRUE;
  2816.     INDECLARATION := TRUE;
  2817.     NEXTONNEWLINE(1, TABSPACES);
  2818.     WHILE SYM = IDENTIFIER DO
  2819.       BEGIN
  2820.         RESETCHARCOUNT;
  2821.         FORMATLINE(INDENT);
  2822.         INDENTPLUS(CONTINUESPACES);
  2823.         CHECK([IDENTIFIER]);
  2824.         IDENTLIST;
  2825.         CHECKSYM(COLON);
  2826.         UNDENT;
  2827.         SCANTYPE;
  2828.         IF SYM = ABSOLUTESYM THEN
  2829.           BEGIN
  2830.             NEXTSYM;
  2831.             CONSTANT;
  2832.             IF SYM = COLON THEN
  2833.               BEGIN
  2834.                 NEXTSYM;
  2835.                 CONSTANT;
  2836.               END;
  2837.           END;
  2838.         CHECKSYM(SEMICOLON);
  2839.       END;
  2840.     UNDENT;
  2841.     STATINDENT := INDENT;
  2842.     INTYPEORVARDCL := FALSE;
  2843.     INDECLARATION := FALSE;
  2844.     NEWLINE(1);
  2845.   END;
  2846.  
  2847.  
  2848. PROCEDURE DOPROGRAM;
  2849.  
  2850.   BEGIN
  2851.     NEXTONNEWLINE(0, CONTINUESPACES);
  2852.     CHECKSYM(IDENTIFIER);
  2853.     IF SYM = OPENPAREN THEN
  2854.       BEGIN
  2855.         NEXTSYM;
  2856.         WHILE SYM = IDENTIFIER DO
  2857.           BEGIN
  2858.             NEXTSYM;
  2859.             IF SYM = COMMA THEN
  2860.               BEGIN
  2861.                 NEXTSYM;
  2862.                 SETSYMBOLBREAK(0);
  2863.               END;
  2864.           END;
  2865.         CHECKSYM(CLOSEPAREN);
  2866.       END;
  2867.     CHECKSYM(SEMICOLON);
  2868.     UNDENT;
  2869.     INDENTPLUS(TABSPACES);
  2870.     DOBLOCK;
  2871.     IF SYM = PERIOD THEN
  2872.       NEXTSYM;
  2873.     UNDENT;
  2874.   END;
  2875.  
  2876.  
  2877. PROCEDURE DOPROCEDURE;
  2878.  
  2879.   VAR
  2880.     STARTSYM: SYMBOLS;
  2881.  
  2882.   BEGIN
  2883.     RESETCHARCOUNT;
  2884.     STARTSYM := SYM;
  2885.     NEXTONNEWLINE(PARAGRAFINDENT, CONTINUESPACES);
  2886.     IF STARTSYM = OVERLAYSYM THEN
  2887.       BEGIN
  2888.         STARTSYM := SYM;
  2889.         IF (SYM <> PROCEDURESYM) AND (SYM <> FUNCTIONSYM) THEN
  2890.           ABORT(SYNTAX);
  2891.         NEXTSYM;
  2892.       END;
  2893.     CHECKSYM(IDENTIFIER);
  2894.     IF SYM = OPENPAREN THEN
  2895.       PARAMETERS;
  2896.     IF STARTSYM = FUNCTIONSYM THEN
  2897.       IF SYM = COLON THEN
  2898.         BEGIN
  2899.           CHECKSYM(COLON);
  2900.           CHECKSYM(IDENTIFIER);
  2901.         END;
  2902.     TERMINALSEMICOLON;
  2903.     UNDENT;
  2904.     CHECKSYM(SEMICOLON);
  2905.     INDENTPLUS(TABSPACES);
  2906.     IF SYM IN [EXTERNSYM, FORWARDSYM] THEN
  2907.       BEGIN
  2908.         FORMATLINE(INDENT);
  2909.         IF SYM = EXTERNSYM THEN
  2910.           BEGIN
  2911.             NEXTSYM;
  2912.             IF SYM <> STRCONST THEN
  2913.               ABORT(SYNTAX);
  2914.           END;
  2915.         NEXTSYM;
  2916.       END
  2917.     ELSE IF SYM IN BLOCKBEGSYS THEN
  2918.       DOBLOCK
  2919.     ELSE
  2920.       ABORT(SYNTAX);
  2921.     IF SYM = SEMICOLON THEN
  2922.       BEGIN
  2923.         PUTSYM;
  2924.         UNDENT;
  2925.         STATINDENT := INDENT;
  2926.         NEXTSYM;
  2927.       END
  2928.     ELSE
  2929.       ABORT(SYNTAX);
  2930.   END;
  2931.  
  2932.  
  2933. PROCEDURE DOUSES;
  2934.  
  2935.   BEGIN
  2936.     RESETCHARCOUNT;
  2937.     UNDENT;
  2938.     NEXTONNEWLINE(1, TABSPACES);
  2939.     FORMATLINE(INDENT);
  2940.     WHILE SYM IN [COMMA, IDENTIFIER] DO
  2941.       BEGIN
  2942.         NEXTSYM;
  2943.         IF SYM = COMMA THEN
  2944.           NEXTSYM;
  2945.       END;
  2946.     CHECKSYM(SEMICOLON);
  2947.     UNDENT;
  2948.   END;
  2949.  
  2950.  
  2951. PROCEDURE DOBLOCK;
  2952.  
  2953.   BEGIN
  2954.     STATINDENT := INDENT;
  2955.     IF SYM = BEGINSYM THEN
  2956.       NEWLINE(1);
  2957.     WHILE SYM IN HEADINGBEGSYS DO
  2958.       BEGIN
  2959.         CASE SYM OF
  2960.           LABELSYM: DOLABEL;
  2961.           CONSTSYM: DOCONST;
  2962.           USESSYM: DOUSES;
  2963.           TYPESYM: DOTYPE;
  2964.           VARSYM: DOVAR;
  2965.           OVERLAYSYM, PROCEDURESYM, FUNCTIONSYM: DOPROCEDURE;
  2966.         END;
  2967.         STATINDENT := INDENT;
  2968.       END;
  2969.     IF SYM = BEGINSYM THEN
  2970.       DOBEGIN(TRUE);
  2971.   END;
  2972.  
  2973.  
  2974. PROCEDURE PROCESSTEXT;
  2975.  
  2976.   BEGIN
  2977.     CLEARBREAKS;
  2978.     IF SYM = PROGRAMSYM THEN
  2979.       DOPROGRAM
  2980.     ELSE IF SYM IN BLOCKBEGSYS THEN
  2981.       BEGIN
  2982.         DOBLOCK;
  2983.         IF SYM = SEMICOLON THEN
  2984.           NEXTSYM;
  2985.         IF SYM = PERIOD THEN
  2986.           NEXTSYM;
  2987.       END
  2988.     ELSE IF SYM IN STATSET THEN
  2989.       STATLIST;
  2990.     CHECK([TEXTEND]);
  2991.     FLUSHBUFFER;
  2992.   END;
  2993.  
  2994.  
  2995. BEGIN
  2996.   INITIALIZE;
  2997.   CSI;
  2998.   GETCHAR;
  2999.   GETSYM;
  3000.   PROCESSTEXT;
  3001.   QUIT;
  3002. END.
  3003.